2 !-----------------------------------------------------------------------------
13 !-----------------------------------------------------------------------------
14 ! Max. number of contacts per residue
16 !-----------------------------------------------------------------------------
17 ! Max. number of derivatives of virtual-bond and side-chain vectors in theta
20 !-----------------------------------------------------------------------------
21 ! Max. number of SC contacts
23 !-----------------------------------------------------------------------------
24 ! Max. number of variables
26 !-----------------------------------------------------------------------------
27 ! Max number of torsional terms in SCCOR in control_data
28 ! integer,parameter :: maxterm_sccor=6
29 !-----------------------------------------------------------------------------
30 ! Maximum number of SC local term fitting function coefficiants
31 integer,parameter :: maxsccoef=65
32 ! Maximum number of local shielding effectors
33 ! integer,parameter :: maxcontsshi=50
34 !-----------------------------------------------------------------------------
35 ! commom.calc common/calc/
36 !-----------------------------------------------------------------------------
39 ! Change 12/1/95 - common block CONTACTS1 included.
42 integer,dimension(:),allocatable :: num_cont !(maxres)
43 integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres)
44 real(kind=8),dimension(:,:),allocatable :: facont,ees0plist !(maxconts,maxres)
45 real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres)
46 integer,dimension(:),allocatable :: ishield_list
47 integer,dimension(:,:),allocatable :: shield_list
48 real(kind=8),dimension(:),allocatable :: enetube,enecavtube
50 ! 12/26/95 - H-bonding contacts
51 ! common /contacts_hb/
52 real(kind=8),dimension(:,:,:),allocatable :: gacontp_hb1,gacontp_hb2,&
53 gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres)
54 real(kind=8),dimension(:,:),allocatable :: facont_hb,ees0p,&
55 ees0m,d_cont !(maxconts,maxres)
56 integer,dimension(:),allocatable :: num_cont_hb !(maxres)
57 integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres)
58 ! 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
60 ! 7/25/08 commented out; not needed when cumulants used
61 ! Interactions of pseudo-dipoles generated by loc-el interactions.
63 real(kind=8),dimension(:,:,:),allocatable :: dip,&
64 dipderg !(4,maxconts,maxres)
65 real(kind=8),dimension(:,:,:,:,:),allocatable :: dipderx !(3,5,4,maxconts,maxres)
66 ! 10/30/99 Added other pre-computed vectors and matrices needed
67 ! to calculate three - six-order el-loc correlation terms
69 real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres)
70 real(kind=8),dimension(:,:),allocatable :: obrot,obrot2,obrot_der,&
71 obrot2_der !(2,maxres)
73 ! This common block contains vectors and matrices dependent on a single
76 real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,&
77 Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres)
78 real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,&
79 CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
80 ! This common block contains vectors and matrices dependent on two
81 ! consecutive amino-acid residues.
83 real(kind=8),dimension(:,:),allocatable :: Ug2Db1t,Ug2Db1tder,&
84 CUgb2,CUgb2der !(2,maxres)
85 real(kind=8),dimension(:,:,:),allocatable :: EUgC,EUgCder,&
86 EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres)
87 real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,&
88 DtUg2EUgder !(2,2,2,maxres)
90 real(kind=8),dimension(:),allocatable :: costab,sintab,&
91 costab2,sintab2 !(maxres)
92 ! This common block contains dipole-interaction matrices and their
93 ! Cartesian derivatives.
95 real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres)
96 real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres)
98 real(kind=8),dimension(2,2,2) :: AEA,AEAderg,EAEA,AECA,&
99 AECAderg,ADtEA,ADtEA1,AEAb1,AEAb1derg,AEAb2
100 real(kind=8),dimension(2,2,2,2) :: EAEAderg,ADtEAderg,&
102 real(kind=8),dimension(2,2,3,5,2,2) :: AEAderx,EAEAderx,&
103 AECAderx,ADtEAderx,ADtEA1derx
104 real(kind=8),dimension(2,3,5,2,2,2) :: AEAb1derx,AEAb2derx
105 real(kind=8),dimension(3,2) :: g_contij
106 real(kind=8) :: ekont
107 ! 12/13/2008 (again Poland-Jaruzel war anniversary)
108 ! RE: Parallelization of 4th and higher order loc-el correlations
109 ! common /contdistrib/
110 integer,dimension(:),allocatable :: ncont_sent,ncont_recv !(maxres)
111 ! ncont_sent,ncont_recv są w multibody_ello i multibody_hb
112 !-----------------------------------------------------------------------------
115 ! real(kind=8),dimension(:,:),allocatable :: dcdv,dxdv !(6,maxdim)
116 ! real(kind=8),dimension(:,:),allocatable :: dxds !(6,maxres)
117 ! real(kind=8),dimension(:,:,:),allocatable :: gradx,gradc !(3,maxres,2)
118 real(kind=8),dimension(:,:),allocatable :: gvdwc,gelc,gelc_long,&
119 gvdwpp,gvdwc_scpp,gradx_scp,gvdwc_scp,ghpbx,ghpbc,&
120 gradcorr,gradcorr_long,gradcorr5_long,gradcorr6_long,&
121 gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6,gliptran,gliptranc,&
123 gshieldx,gshieldc,gshieldc_loc,gshieldx_ec,&
124 gshieldc_ec,gshieldc_loc_ec,gshieldx_t3, &
125 gshieldc_t3,gshieldc_loc_t3,gshieldx_t4,gshieldc_t4, &
126 gshieldc_loc_t4,gshieldx_ll,gshieldc_ll,gshieldc_loc_ll,&
127 grad_shield,gg_tube,gg_tube_sc,gradafm !(3,maxres)
128 !-----------------------------NUCLEIC GRADIENT
129 real(kind=8),dimension(:,:),allocatable ::gradb_nucl,gradbx_nucl, &
130 gvdwpsb1,gelpp,gvdwpsb,gelsbc,gelsbx,gvdwsbx,gvdwsbc,gsbloc,&
131 gsblocx,gradcorr_nucl,gradxorr_nucl,gradcorr3_nucl,gradxorr3_nucl,&
133 !-----------------------------NUCLEIC-PROTEIN GRADIENT
134 real(kind=8),dimension(:,:),allocatable :: gvdwx_scbase,gvdwc_scbase,&
135 gvdwx_pepbase,gvdwc_pepbase,gvdwx_scpho,gvdwc_scpho,&
137 !------------------------------IONS GRADIENT
138 real(kind=8),dimension(:,:),allocatable :: gradcatcat, &
139 gradpepcat,gradpepcatx
140 ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
143 real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
144 gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
145 real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
146 gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
147 g_corr6_loc !(maxvar)
148 real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
149 real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
150 ! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
151 real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
152 ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
153 real(kind=8),dimension(:,:,:),allocatable :: grad_shield_side, &
154 grad_shield_loc ! (3,maxcontsshileding,maxnres)
157 real(kind=8), dimension(:),allocatable :: fac_shield
158 real(kind=8),dimension(3,5,2) :: derx,derx_turn
159 ! common /deriv_scloc/
160 real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
161 dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
162 dZZ_XYZtab !(3,maxres)
163 !-----------------------------------------------------------------------------
166 real(kind=8) :: gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,&
167 gradb_max,ghpbc_max,&
168 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
169 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
170 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
171 gsccorx_max,gsclocx_max
172 !-----------------------------------------------------------------------------
174 ! common /back_constr/
175 real(kind=8),dimension(:),allocatable :: dutheta,dugamma !(maxres)
176 real(kind=8),dimension(:,:),allocatable :: duscdiff,duscdiffx !(3,maxres)
178 real(kind=8) :: Ucdfrag,Ucdpair
179 real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
180 dqwol,dxqwol !(3,0:MAXRES)
181 !-----------------------------------------------------------------------------
183 ! common /dyn_ssbond/
184 real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
185 !-----------------------------------------------------------------------------
187 ! Parameters of the SCCOR term
189 real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
190 dcosomicron,domicron !(3,3,3,maxres2)
191 !-----------------------------------------------------------------------------
194 real(kind=8),dimension(:,:),allocatable :: uy,uz !(3,maxres)
195 real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
196 !-----------------------------------------------------------------------------
197 ! common /przechowalnia/
198 real(kind=8),dimension(:,:,:),allocatable :: zapas
199 real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs)
200 real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
201 !-----------------------------------------------------------------------------
202 !-----------------------------------------------------------------------------
205 !-----------------------------------------------------------------------------
207 !-----------------------------------------------------------------------------
208 ! energy_p_new_barrier.F
209 !-----------------------------------------------------------------------------
210 subroutine etotal(energia)
211 ! implicit real*8 (a-h,o-z)
212 ! include 'DIMENSIONS'
217 !MS$ATTRIBUTES C :: proc_proc
223 ! include 'COMMON.SETUP'
224 ! include 'COMMON.IOUNITS'
225 real(kind=8),dimension(0:n_ene) :: energia
226 ! include 'COMMON.LOCAL'
227 ! include 'COMMON.FFIELD'
228 ! include 'COMMON.DERIV'
229 ! include 'COMMON.INTERACT'
230 ! include 'COMMON.SBRIDGE'
231 ! include 'COMMON.CHAIN'
232 ! include 'COMMON.VAR'
233 ! include 'COMMON.MD'
234 ! include 'COMMON.CONTROL'
235 ! include 'COMMON.TIME1'
236 real(kind=8) :: time00
238 integer :: n_corr,n_corr1,ierror
239 real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
240 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
241 real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
242 Eafmforce,ethetacnstr
243 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
244 ! now energies for nulceic alone parameters
245 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
246 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
249 real(kind=8) :: ecation_prot,ecationcation
250 ! energies for protein nucleic acid interaction
251 real(kind=8) :: escbase,epepbase,escpho,epeppho
254 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
255 ! shielding effect varibles for MPI
256 real(kind=8) :: fac_shieldbuf(nres), &
257 grad_shield_locbuf1(3*maxcontsshi*nres), &
258 grad_shield_sidebuf1(3*maxcontsshi*nres), &
259 grad_shield_locbuf2(3*maxcontsshi*nres), &
260 grad_shield_sidebuf2(3*maxcontsshi*nres), &
261 grad_shieldbuf1(3*nres), &
262 grad_shieldbuf2(3*nres)
264 integer ishield_listbuf(-1:nres), &
265 shield_listbuf(maxcontsshi,-1:nres),k,j,i,iii,impishi,mojint,jjj
268 ! real(kind=8), dimension(:),allocatable:: fac_shieldbuf
269 ! real(kind=8), dimension(:,:,:),allocatable:: &
270 ! grad_shield_locbuf,grad_shield_sidebuf
271 ! real(kind=8), dimension(:,:),allocatable:: &
273 ! integer, dimension(:),allocatable:: &
275 ! integer, dimension(:,:),allocatable:: shield_listbuf
277 ! if (.not.allocated(fac_shieldbuf)) then
278 ! allocate(fac_shieldbuf(nres))
279 ! allocate(grad_shield_locbuf(3,maxcontsshi,-1:nres))
280 ! allocate(grad_shield_sidebuf(3,maxcontsshi,-1:nres))
281 ! allocate(grad_shieldbuf(3,-1:nres))
282 ! allocate(ishield_listbuf(nres))
283 ! allocate(shield_listbuf(maxcontsshi,nres))
286 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
287 ! & " nfgtasks",nfgtasks
288 if (nfgtasks.gt.1) then
290 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
291 if (fg_rank.eq.0) then
292 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
293 ! print *,"Processor",myrank," BROADCAST iorder"
294 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
295 ! FG slaves as WEIGHTS array.
315 weights_(26)=wvdwpp_nucl
321 weights_(32)=wbond_nucl
322 weights_(33)=wang_nucl
324 weights_(35)=wtor_nucl
325 weights_(36)=wtor_d_nucl
326 weights_(37)=wcorr_nucl
327 weights_(38)=wcorr3_nucl
329 weights_(42)=wcatprot
333 ! wcatcat= weights(41)
334 ! wcatprot=weights(42)
336 ! FG Master broadcasts the WEIGHTS_ array
337 call MPI_Bcast(weights_(1),n_ene,&
338 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
340 ! FG slaves receive the WEIGHTS array
341 call MPI_Bcast(weights(1),n_ene,&
342 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
362 wvdwpp_nucl =weights(26)
368 wbond_nucl =weights(32)
369 wang_nucl =weights(33)
371 wtor_nucl =weights(35)
372 wtor_d_nucl =weights(36)
373 wcorr_nucl =weights(37)
374 wcorr3_nucl =weights(38)
381 time_Bcast=time_Bcast+MPI_Wtime()-time00
382 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
383 ! call chainbuild_cart
385 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
386 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
388 ! if (modecalc.eq.12.or.modecalc.eq.14) then
389 ! call int_from_cart1(.false.)
396 ! Compute the side-chain and electrostatic interaction energy
397 ! print *, "Before EVDW"
398 ! goto (101,102,103,104,105,106) ipot
400 ! Lennard-Jones potential.
404 !d print '(a)','Exit ELJcall el'
406 ! Lennard-Jones-Kihara potential (shifted).
407 ! 102 call eljk(evdw)
411 ! Berne-Pechukas potential (dilated LJ, angular dependence).
416 ! Gay-Berne potential (shifted LJ, angular dependence).
419 ! print *,"MOMO",scelemode
420 if (scelemode.eq.0) then
426 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
427 ! 105 call egbv(evdw)
431 ! Soft-sphere potential
432 ! 106 call e_softsphere(evdw)
434 call e_softsphere(evdw)
436 ! Calculate electrostatic (H-bonding) energy of the main chain.
440 write(iout,*)"Wrong ipot"
445 ! print *,"after EGB"
447 if (shield_mode.eq.2) then
450 if (nfgtasks.gt.1) then
451 grad_shield_sidebuf1(:)=0.0d0
452 grad_shield_locbuf1(:)=0.0d0
453 grad_shield_sidebuf2(:)=0.0d0
454 grad_shield_locbuf2(:)=0.0d0
455 grad_shieldbuf1(:)=0.0d0
456 grad_shieldbuf2(:)=0.0d0
459 write(iout,*) "befor reduce fac_shield reduce"
461 write(2,*) "fac",itype(i,1),fac_shield(i),grad_shield(1,i)
462 write(2,*) "list", shield_list(1,i),ishield_list(i), &
463 grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
472 grad_shieldbuf1(iii)=grad_shield(k,i)
479 grad_shield_sidebuf1(jjj)=grad_shield_side(k,j,i)
480 grad_shield_locbuf1(jjj)=grad_shield_loc(k,j,i)
484 call MPI_Allgatherv(fac_shield(ivec_start), &
485 ivec_count(fg_rank1), &
486 MPI_DOUBLE_PRECISION,fac_shieldbuf(1),ivec_count(0), &
488 MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
489 call MPI_Allgatherv(shield_list(1,ivec_start), &
490 ivec_count(fg_rank1), &
491 MPI_I50,shield_listbuf(1,1),ivec_count(0), &
493 MPI_I50,FG_COMM,IERROR)
494 ! write(2,*) "After I50"
496 call MPI_Allgatherv(ishield_list(ivec_start), &
497 ivec_count(fg_rank1), &
498 MPI_INTEGER,ishield_listbuf(1),ivec_count(0), &
500 MPI_INTEGER,FG_COMM,IERROR)
501 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
503 ! write(2,*) ivec_count(fg_rank1)*3,ivec_count(0)*3,ivec_displ(0)*3,3*ivec_start-2
504 ! write (2,*) "before"
505 ! write(2,*) grad_shieldbuf1
506 ! call MPI_Allgatherv(grad_shieldbuf1(3*ivec_start-2), &
507 ! ivec_count(fg_rank1)*3, &
508 ! MPI_DOUBLE_PRECISION,grad_shieldbuf2(1),ivec_count(0), &
510 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
511 call MPI_Allreduce(grad_shieldbuf1(1),grad_shieldbuf2(1), &
513 MPI_DOUBLE_PRECISION, &
516 call MPI_Allreduce(grad_shield_sidebuf1(1),grad_shield_sidebuf2(1), &
517 nres*3*maxcontsshi, &
518 MPI_DOUBLE_PRECISION, &
522 call MPI_Allreduce(grad_shield_locbuf1(1),grad_shield_locbuf2(1), &
523 nres*3*maxcontsshi, &
524 MPI_DOUBLE_PRECISION, &
529 ! write(2,*) grad_shieldbuf2
531 ! call MPI_Allgatherv(grad_shield_sidebuf1(3*maxcontsshi*ivec_start-2), &
532 ! ivec_count(fg_rank1)*3*maxcontsshi, &
533 ! MPI_DOUBLE_PRECISION,grad_shield_sidebuf2(1),ivec_count(0)*3*maxcontsshi,&
534 ! ivec_displ(0)*3*maxcontsshi, &
535 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
536 ! write(2,*) "After grad_shield_side"
538 ! call MPI_Allgatherv(grad_shield_locbuf1(3*maxcontsshi*ivec_start-2), &
539 ! ivec_count(fg_rank1)*3*maxcontsshi, &
540 ! MPI_DOUBLE_PRECISION,grad_shield_locbuf2(1),ivec_count(0)*3*maxcontsshi, &
541 ! ivec_displ(0)*3*maxcontsshi, &
542 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
543 ! write(2,*) "After MPI_SHI"
548 fac_shield(i)=fac_shieldbuf(i)
549 ishield_list(i)=ishield_listbuf(i)
550 ! write(iout,*) i,fac_shield(i)
553 grad_shield(j,i)=grad_shieldbuf2(iii)
555 do j=1,ishield_list(i)
556 ! write (iout,*) "ishild", ishield_list(i),i
557 shield_list(j,i)=shield_listbuf(j,i)
562 grad_shield_loc(k,j,i)=grad_shield_locbuf2(jjj)
563 grad_shield_side(k,j,i)=grad_shield_sidebuf2(jjj)
569 write(iout,*) "after reduce fac_shield reduce"
571 write(2,*) "fac",itype(i,1),fac_shield(i),grad_shield(1,i)
572 write(2,*) "list", shield_list(1,i),ishield_list(i), &
573 grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
581 ! print *,"AFTER EGB",ipot,evdw
583 !mc Sep-06: egb takes care of dynamic ss bonds too
585 ! if (dyn_ss) call dyn_set_nss
586 ! print *,"Processor",myrank," computed USCSC"
592 time_vec=time_vec+MPI_Wtime()-time01
598 ! print *,"Processor",myrank," left VEC_AND_DERIV"
601 ! print *,"after ipot if", ipot
602 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
603 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
604 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
605 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
607 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
608 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
609 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
610 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
612 write(iout,*),"just befor eelec call"
613 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
614 ! write (iout,*) "ELEC calc"
623 ! write (iout,*) "Soft-spheer ELEC potential"
624 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
627 ! print *,"Processor",myrank," computed UELEC"
629 ! Calculate excluded-volume interaction energy between peptide groups
632 ! write(iout,*) "in etotal calc exc;luded",ipot
636 call escp(evdw2,evdw2_14)
642 ! write (iout,*) "Soft-sphere SCP potential"
643 call escp_soft_sphere(evdw2,evdw2_14)
645 ! write(iout,*) "in etotal before ebond",ipot
648 ! Calculate the bond-stretching energy
651 ! print *,"EBOND",estr
652 ! write(iout,*) "in etotal afer ebond",ipot
655 ! Calculate the disulfide-bridge and other energy and the contributions
656 ! from other distance constraints.
657 ! print *,'Calling EHPB'
659 !elwrite(iout,*) "in etotal afer edis",ipot
660 ! print *,'EHPB exitted succesfully.'
662 ! Calculate the virtual-bond-angle energy.
663 ! write(iout,*) "in etotal afer edis",ipot
665 if (wang.gt.0.0d0) then
666 call ebend(ebe,ethetacnstr)
671 ! write(iout,*) "in etotal afer ebe",ipot
673 ! print *,"Processor",myrank," computed UB"
675 ! Calculate the SC local energy.
678 !elwrite(iout,*) "in etotal afer esc",ipot
679 ! print *,"Processor",myrank," computed USC"
681 ! Calculate the virtual-bond torsional energy.
683 !d print *,'nterm=',nterm
685 call etor(etors,edihcnstr)
690 ! print *,"Processor",myrank," computed Utor"
693 ! 6/23/01 Calculate double-torsional energy
695 !elwrite(iout,*) "in etotal",ipot
696 if (wtor_d.gt.0) then
701 ! print *,"Processor",myrank," computed Utord"
703 ! 21/5/07 Calculate local sicdechain correlation energy
705 if (wsccor.gt.0.0d0) then
706 call eback_sc_corr(esccor)
711 ! write(iout,*) "before multibody"
713 ! print *,"Processor",myrank," computed Usccorr"
715 ! 12/1/95 Multi-body terms
720 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
721 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
722 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
723 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
724 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
731 !elwrite(iout,*) "in etotal",ipot
732 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
733 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
734 !d write (iout,*) "multibody_hb ecorr",ecorr
736 ! write(iout,*) "afeter multibody hb"
738 ! print *,"Processor",myrank," computed Ucorr"
740 ! If performing constraint dynamics, call the constraint energy
741 ! after the equilibration time
742 if(usampl.and.totT.gt.eq_time) then
743 !elwrite(iout,*) "afeter multibody hb"
745 !elwrite(iout,*) "afeter multibody hb"
747 !elwrite(iout,*) "afeter multibody hb"
753 ! write(iout,*) "after Econstr"
755 if (wliptran.gt.0) then
756 ! print *,"PRZED WYWOLANIEM"
757 call Eliptransfer(eliptran)
761 if (fg_rank.eq.0) then
762 if (AFMlog.gt.0) then
763 call AFMforce(Eafmforce)
764 else if (selfguide.gt.0) then
765 call AFMvel(Eafmforce)
768 if (tubemode.eq.1) then
770 else if (tubemode.eq.2) then
771 call calctube2(etube)
772 elseif (tubemode.eq.3) then
777 !--------------------------------------------------------
778 ! write (iout,*) "NRES_MOLEC(2),",nres_molec(2)
779 ! print *,"before",ees,evdw1,ecorr
780 ! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
781 if (nres_molec(2).gt.0) then
782 call ebond_nucl(estr_nucl)
783 call ebend_nucl(ebe_nucl)
784 call etor_nucl(etors_nucl)
785 call esb_gb(evdwsb,eelsb)
786 call epp_nucl_sub(evdwpp,eespp)
787 call epsb(evdwpsb,eelpsb)
789 call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
803 ! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
804 if (nfgtasks.gt.1) then
805 if (fg_rank.eq.0) then
806 call ecatcat(ecationcation)
809 call ecatcat(ecationcation)
811 call ecat_prot(ecation_prot)
812 if (nres_molec(2).gt.0) then
813 call eprot_sc_base(escbase)
814 call epep_sc_base(epepbase)
815 call eprot_sc_phosphate(escpho)
816 call eprot_pep_phosphate(epeppho)
823 ! call ecatcat(ecationcation)
824 ! print *,"after ebend", ebe_nucl
826 time_enecalc=time_enecalc+MPI_Wtime()-time00
828 ! print *,"Processor",myrank," computed Uconstr"
837 energia(2)=evdw2-evdw2_14
854 energia(8)=eello_turn3
855 energia(9)=eello_turn4
862 energia(19)=edihcnstr
864 energia(20)=Uconst+Uconst_back
867 energia(23)=Eafmforce
868 energia(24)=ethetacnstr
870 !---------------------------------------------------------------
877 energia(32)=estr_nucl
880 energia(35)=etors_nucl
881 energia(36)=etors_d_nucl
882 energia(37)=ecorr_nucl
883 energia(38)=ecorr3_nucl
884 !----------------------------------------------------------------------
885 ! Here are the energies showed per procesor if the are more processors
886 ! per molecule then we sum it up in sum_energy subroutine
887 ! print *," Processor",myrank," calls SUM_ENERGY"
888 energia(41)=ecation_prot
889 energia(42)=ecationcation
894 call sum_energy(energia,.true.)
895 if (dyn_ss) call dyn_set_nss
896 ! print *," Processor",myrank," left SUM_ENERGY"
898 time_sumene=time_sumene+MPI_Wtime()-time00
900 ! call enerprint(energia)
901 !elwrite(iout,*)"finish etotal"
903 end subroutine etotal
904 !-----------------------------------------------------------------------------
905 subroutine sum_energy(energia,reduce)
906 ! implicit real*8 (a-h,o-z)
907 ! include 'DIMENSIONS'
911 !MS$ATTRIBUTES C :: proc_proc
917 ! include 'COMMON.SETUP'
918 ! include 'COMMON.IOUNITS'
919 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
920 ! include 'COMMON.FFIELD'
921 ! include 'COMMON.DERIV'
922 ! include 'COMMON.INTERACT'
923 ! include 'COMMON.SBRIDGE'
924 ! include 'COMMON.CHAIN'
925 ! include 'COMMON.VAR'
926 ! include 'COMMON.CONTROL'
927 ! include 'COMMON.TIME1'
929 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
930 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
931 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
932 eliptran,etube, Eafmforce,ethetacnstr
933 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
934 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
936 real(kind=8) :: ecation_prot,ecationcation
937 real(kind=8) :: escbase,epepbase,escpho,epeppho
941 real(kind=8) :: time00
942 if (nfgtasks.gt.1 .and. reduce) then
945 write (iout,*) "energies before REDUCE"
946 call enerprint(energia)
950 enebuff(i)=energia(i)
953 call MPI_Barrier(FG_COMM,IERR)
954 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
956 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
957 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
959 write (iout,*) "energies after REDUCE"
960 call enerprint(energia)
963 time_Reduce=time_Reduce+MPI_Wtime()-time00
965 if (fg_rank.eq.0) then
969 evdw2=energia(2)+energia(18)
985 eello_turn3=energia(8)
986 eello_turn4=energia(9)
993 edihcnstr=energia(19)
998 Eafmforce=energia(23)
999 ethetacnstr=energia(24)
1007 estr_nucl=energia(32)
1008 ebe_nucl=energia(33)
1010 etors_nucl=energia(35)
1011 etors_d_nucl=energia(36)
1012 ecorr_nucl=energia(37)
1013 ecorr3_nucl=energia(38)
1014 ecation_prot=energia(41)
1015 ecationcation=energia(42)
1017 epepbase=energia(47)
1020 ! energia(41)=ecation_prot
1021 ! energia(42)=ecationcation
1025 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
1026 +wang*ebe+wtor*etors+wscloc*escloc &
1027 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
1028 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
1029 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
1030 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
1031 +Eafmforce+ethetacnstr &
1032 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
1033 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
1034 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
1035 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
1036 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
1037 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
1039 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
1040 +wang*ebe+wtor*etors+wscloc*escloc &
1041 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
1042 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
1043 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
1044 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
1045 +Eafmforce+ethetacnstr &
1046 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
1047 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
1048 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
1049 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
1050 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
1051 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
1057 if (isnan(etot).ne.0) energia(0)=1.0d+99
1059 if (isnan(etot)) energia(0)=1.0d+99
1064 idumm=proc_proc(etot,i)
1066 call proc_proc(etot,i)
1068 if(i.eq.1)energia(0)=1.0d+99
1073 ! call enerprint(energia)
1076 end subroutine sum_energy
1077 !-----------------------------------------------------------------------------
1078 subroutine rescale_weights(t_bath)
1079 ! implicit real*8 (a-h,o-z)
1083 ! include 'DIMENSIONS'
1084 ! include 'COMMON.IOUNITS'
1085 ! include 'COMMON.FFIELD'
1086 ! include 'COMMON.SBRIDGE'
1087 real(kind=8) :: kfac=2.4d0
1088 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
1090 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
1091 real(kind=8) :: T0=3.0d2
1094 ! facT=2*temp0/(t_bath+temp0)
1095 if (rescale_mode.eq.0) then
1102 else if (rescale_mode.eq.1) then
1103 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
1104 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1105 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1106 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1107 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1109 !#if defined(WHAM_RUN) || defined(CLUSTER)
1111 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
1112 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1113 #elif defined(FUNCT)
1119 else if (rescale_mode.eq.2) then
1125 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
1126 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
1127 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
1128 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
1129 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
1131 !#if defined(WHAM_RUN) || defined(CLUSTER)
1133 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1134 #elif defined(FUNCT)
1141 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1142 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1144 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1148 welec=weights(3)*fact(1)
1149 wcorr=weights(4)*fact(3)
1150 wcorr5=weights(5)*fact(4)
1151 wcorr6=weights(6)*fact(5)
1152 wel_loc=weights(7)*fact(2)
1153 wturn3=weights(8)*fact(2)
1154 wturn4=weights(9)*fact(3)
1155 wturn6=weights(10)*fact(5)
1156 wtor=weights(13)*fact(1)
1157 wtor_d=weights(14)*fact(2)
1158 wsccor=weights(21)*fact(1)
1161 end subroutine rescale_weights
1162 !-----------------------------------------------------------------------------
1163 subroutine enerprint(energia)
1164 ! implicit real*8 (a-h,o-z)
1165 ! include 'DIMENSIONS'
1166 ! include 'COMMON.IOUNITS'
1167 ! include 'COMMON.FFIELD'
1168 ! include 'COMMON.SBRIDGE'
1169 ! include 'COMMON.MD'
1170 real(kind=8) :: energia(0:n_ene)
1172 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
1173 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
1174 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
1175 etube,ethetacnstr,Eafmforce
1176 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
1177 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
1179 real(kind=8) :: ecation_prot,ecationcation
1180 real(kind=8) :: escbase,epepbase,escpho,epeppho
1186 evdw2=energia(2)+energia(18)
1198 eello_turn3=energia(8)
1199 eello_turn4=energia(9)
1200 eello_turn6=energia(10)
1206 edihcnstr=energia(19)
1210 eliptran=energia(22)
1211 Eafmforce=energia(23)
1212 ethetacnstr=energia(24)
1220 estr_nucl=energia(32)
1221 ebe_nucl=energia(33)
1223 etors_nucl=energia(35)
1224 etors_d_nucl=energia(36)
1225 ecorr_nucl=energia(37)
1226 ecorr3_nucl=energia(38)
1227 ecation_prot=energia(41)
1228 ecationcation=energia(42)
1230 epepbase=energia(47)
1234 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
1235 estr,wbond,ebe,wang,&
1236 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1238 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1239 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
1240 edihcnstr,ethetacnstr,ebr*nss,&
1241 Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
1242 estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, &
1243 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
1244 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
1245 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1246 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1247 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1249 10 format (/'Virtual-chain energies:'// &
1250 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1251 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1252 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1253 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
1254 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1255 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1256 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1257 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1258 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1259 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1260 ' (SS bridges & dist. cnstr.)'/ &
1261 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1262 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1263 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1264 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1265 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1266 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1267 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1268 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1269 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1270 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1271 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1272 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
1273 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
1274 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1275 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1276 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1277 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1278 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1279 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1280 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1281 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1282 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1283 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1284 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1285 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1286 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1287 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1288 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1289 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1290 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1291 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1292 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1293 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1294 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1295 'ETOT= ',1pE16.6,' (total)')
1297 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
1298 estr,wbond,ebe,wang,&
1299 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1301 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1302 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
1303 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
1305 estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
1306 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb&
1307 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl&
1308 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1309 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1310 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1312 10 format (/'Virtual-chain energies:'// &
1313 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1314 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1315 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1316 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1317 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1318 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1319 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1320 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1321 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1322 ' (SS bridges & dist. cnstr.)'/ &
1323 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1324 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1325 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1326 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1327 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1328 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1329 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1330 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1331 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1332 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1333 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1334 'UCONST=',1pE16.6,' (Constraint energy)'/ &
1335 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
1336 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1337 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1338 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1339 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1340 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1341 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1342 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1343 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1344 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1345 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1346 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1347 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1348 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1349 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1350 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1351 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1352 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1353 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1354 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1355 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1356 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1357 'ETOT= ',1pE16.6,' (total)')
1360 end subroutine enerprint
1361 !-----------------------------------------------------------------------------
1362 subroutine elj(evdw)
1364 ! This subroutine calculates the interaction energy of nonbonded side chains
1365 ! assuming the LJ potential of interaction.
1367 ! implicit real*8 (a-h,o-z)
1368 ! include 'DIMENSIONS'
1369 real(kind=8),parameter :: accur=1.0d-10
1370 ! include 'COMMON.GEO'
1371 ! include 'COMMON.VAR'
1372 ! include 'COMMON.LOCAL'
1373 ! include 'COMMON.CHAIN'
1374 ! include 'COMMON.DERIV'
1375 ! include 'COMMON.INTERACT'
1376 ! include 'COMMON.TORSION'
1377 ! include 'COMMON.SBRIDGE'
1378 ! include 'COMMON.NAMES'
1379 ! include 'COMMON.IOUNITS'
1380 ! include 'COMMON.CONTACTS'
1381 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1382 integer :: num_conti
1384 integer :: i,itypi,iint,j,itypi1,itypj,k
1385 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
1386 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
1387 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
1389 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1391 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
1392 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
1393 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
1394 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
1396 do i=iatsc_s,iatsc_e
1397 itypi=iabs(itype(i,1))
1398 if (itypi.eq.ntyp1) cycle
1399 itypi1=iabs(itype(i+1,1))
1406 ! Calculate SC interaction energy.
1408 do iint=1,nint_gr(i)
1409 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1410 !d & 'iend=',iend(i,iint)
1411 do j=istart(i,iint),iend(i,iint)
1412 itypj=iabs(itype(j,1))
1413 if (itypj.eq.ntyp1) cycle
1417 ! Change 12/1/95 to calculate four-body interactions
1418 rij=xj*xj+yj*yj+zj*zj
1420 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1421 eps0ij=eps(itypi,itypj)
1423 e1=fac*fac*aa_aq(itypi,itypj)
1424 e2=fac*bb_aq(itypi,itypj)
1426 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1427 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1428 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1429 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1430 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1431 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1434 ! Calculate the components of the gradient in DC and X
1436 fac=-rrij*(e1+evdwij)
1441 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1442 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1443 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1444 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1448 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1452 ! 12/1/95, revised on 5/20/97
1454 ! Calculate the contact function. The ith column of the array JCONT will
1455 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1456 ! greater than I). The arrays FACONT and GACONT will contain the values of
1457 ! the contact function and its derivative.
1459 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1460 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1461 ! Uncomment next line, if the correlation interactions are contact function only
1462 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1464 sigij=sigma(itypi,itypj)
1465 r0ij=rs0(itypi,itypj)
1467 ! Check whether the SC's are not too far to make a contact.
1470 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1471 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1473 if (fcont.gt.0.0D0) then
1474 ! If the SC-SC distance if close to sigma, apply spline.
1475 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1476 !Adam & fcont1,fprimcont1)
1477 !Adam fcont1=1.0d0-fcont1
1478 !Adam if (fcont1.gt.0.0d0) then
1479 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1480 !Adam fcont=fcont*fcont1
1482 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1483 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1485 !ga gg(k)=gg(k)*eps0ij
1487 !ga eps0ij=-evdwij*eps0ij
1488 ! Uncomment for AL's type of SC correlation interactions.
1489 !adam eps0ij=-evdwij
1490 num_conti=num_conti+1
1491 jcont(num_conti,i)=j
1492 facont(num_conti,i)=fcont*eps0ij
1493 fprimcont=eps0ij*fprimcont/rij
1495 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1496 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1497 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1498 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1499 gacont(1,num_conti,i)=-fprimcont*xj
1500 gacont(2,num_conti,i)=-fprimcont*yj
1501 gacont(3,num_conti,i)=-fprimcont*zj
1502 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1503 !d write (iout,'(2i3,3f10.5)')
1504 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1510 num_cont(i)=num_conti
1514 gvdwc(j,i)=expon*gvdwc(j,i)
1515 gvdwx(j,i)=expon*gvdwx(j,i)
1518 !******************************************************************************
1522 ! To save time, the factor of EXPON has been extracted from ALL components
1523 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1526 !******************************************************************************
1529 !-----------------------------------------------------------------------------
1530 subroutine eljk(evdw)
1532 ! This subroutine calculates the interaction energy of nonbonded side chains
1533 ! assuming the LJK potential of interaction.
1535 ! implicit real*8 (a-h,o-z)
1536 ! include 'DIMENSIONS'
1537 ! include 'COMMON.GEO'
1538 ! include 'COMMON.VAR'
1539 ! include 'COMMON.LOCAL'
1540 ! include 'COMMON.CHAIN'
1541 ! include 'COMMON.DERIV'
1542 ! include 'COMMON.INTERACT'
1543 ! include 'COMMON.IOUNITS'
1544 ! include 'COMMON.NAMES'
1545 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1548 integer :: i,iint,j,itypi,itypi1,k,itypj
1549 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1550 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1552 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1554 do i=iatsc_s,iatsc_e
1555 itypi=iabs(itype(i,1))
1556 if (itypi.eq.ntyp1) cycle
1557 itypi1=iabs(itype(i+1,1))
1562 ! Calculate SC interaction energy.
1564 do iint=1,nint_gr(i)
1565 do j=istart(i,iint),iend(i,iint)
1566 itypj=iabs(itype(j,1))
1567 if (itypj.eq.ntyp1) cycle
1571 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1572 fac_augm=rrij**expon
1573 e_augm=augm(itypi,itypj)*fac_augm
1574 r_inv_ij=dsqrt(rrij)
1576 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1577 fac=r_shift_inv**expon
1578 e1=fac*fac*aa_aq(itypi,itypj)
1579 e2=fac*bb_aq(itypi,itypj)
1581 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1582 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1583 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1584 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1585 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1586 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1587 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1590 ! Calculate the components of the gradient in DC and X
1592 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1597 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1598 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1599 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1600 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1604 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1612 gvdwc(j,i)=expon*gvdwc(j,i)
1613 gvdwx(j,i)=expon*gvdwx(j,i)
1618 !-----------------------------------------------------------------------------
1619 subroutine ebp(evdw)
1621 ! This subroutine calculates the interaction energy of nonbonded side chains
1622 ! assuming the Berne-Pechukas potential of interaction.
1626 ! implicit real*8 (a-h,o-z)
1627 ! include 'DIMENSIONS'
1628 ! include 'COMMON.GEO'
1629 ! include 'COMMON.VAR'
1630 ! include 'COMMON.LOCAL'
1631 ! include 'COMMON.CHAIN'
1632 ! include 'COMMON.DERIV'
1633 ! include 'COMMON.NAMES'
1634 ! include 'COMMON.INTERACT'
1635 ! include 'COMMON.IOUNITS'
1636 ! include 'COMMON.CALC'
1638 !el integer :: icall
1639 !el common /srutu/ icall
1640 ! double precision rrsave(maxdim)
1643 integer :: iint,itypi,itypi1,itypj
1644 real(kind=8) :: rrij,xi,yi,zi
1645 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1647 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1649 ! if (icall.eq.0) then
1655 do i=iatsc_s,iatsc_e
1656 itypi=iabs(itype(i,1))
1657 if (itypi.eq.ntyp1) cycle
1658 itypi1=iabs(itype(i+1,1))
1662 dxi=dc_norm(1,nres+i)
1663 dyi=dc_norm(2,nres+i)
1664 dzi=dc_norm(3,nres+i)
1665 ! dsci_inv=dsc_inv(itypi)
1666 dsci_inv=vbld_inv(i+nres)
1668 ! Calculate SC interaction energy.
1670 do iint=1,nint_gr(i)
1671 do j=istart(i,iint),iend(i,iint)
1673 itypj=iabs(itype(j,1))
1674 if (itypj.eq.ntyp1) cycle
1675 ! dscj_inv=dsc_inv(itypj)
1676 dscj_inv=vbld_inv(j+nres)
1677 chi1=chi(itypi,itypj)
1678 chi2=chi(itypj,itypi)
1685 alf12=0.5D0*(alf1+alf2)
1686 ! For diagnostics only!!!
1699 dxj=dc_norm(1,nres+j)
1700 dyj=dc_norm(2,nres+j)
1701 dzj=dc_norm(3,nres+j)
1702 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1703 !d if (icall.eq.0) then
1709 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1711 ! Calculate whole angle-dependent part of epsilon and contributions
1712 ! to its derivatives
1713 fac=(rrij*sigsq)**expon2
1714 e1=fac*fac*aa_aq(itypi,itypj)
1715 e2=fac*bb_aq(itypi,itypj)
1716 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1717 eps2der=evdwij*eps3rt
1718 eps3der=evdwij*eps2rt
1719 evdwij=evdwij*eps2rt*eps3rt
1722 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1723 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1724 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1725 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1726 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1727 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1728 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1731 ! Calculate gradient components.
1732 e1=e1*eps1*eps2rt**2*eps3rt**2
1733 fac=-expon*(e1+evdwij)
1736 ! Calculate radial part of the gradient
1740 ! Calculate the angular part of the gradient and sum add the contributions
1741 ! to the appropriate components of the Cartesian gradient.
1749 !-----------------------------------------------------------------------------
1750 subroutine egb(evdw)
1752 ! This subroutine calculates the interaction energy of nonbonded side chains
1753 ! assuming the Gay-Berne potential of interaction.
1756 ! implicit real*8 (a-h,o-z)
1757 ! include 'DIMENSIONS'
1758 ! include 'COMMON.GEO'
1759 ! include 'COMMON.VAR'
1760 ! include 'COMMON.LOCAL'
1761 ! include 'COMMON.CHAIN'
1762 ! include 'COMMON.DERIV'
1763 ! include 'COMMON.NAMES'
1764 ! include 'COMMON.INTERACT'
1765 ! include 'COMMON.IOUNITS'
1766 ! include 'COMMON.CALC'
1767 ! include 'COMMON.CONTROL'
1768 ! include 'COMMON.SBRIDGE'
1771 integer :: iint,itypi,itypi1,itypj,subchap
1772 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1773 real(kind=8) :: evdw,sig0ij
1774 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1775 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1776 sslipi,sslipj,faclip
1778 real(kind=8) :: fracinbuf
1780 !cccc energy_dec=.false.
1781 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1784 ! if (icall.eq.0) lprn=.false.
1794 do i=iatsc_s,iatsc_e
1795 !C print *,"I am in EVDW",i
1796 itypi=iabs(itype(i,1))
1797 ! if (i.ne.47) cycle
1798 if (itypi.eq.ntyp1) cycle
1799 itypi1=iabs(itype(i+1,1))
1803 xi=dmod(xi,boxxsize)
1804 if (xi.lt.0) xi=xi+boxxsize
1805 yi=dmod(yi,boxysize)
1806 if (yi.lt.0) yi=yi+boxysize
1807 zi=dmod(zi,boxzsize)
1808 if (zi.lt.0) zi=zi+boxzsize
1810 if ((zi.gt.bordlipbot) &
1811 .and.(zi.lt.bordliptop)) then
1812 !C the energy transfer exist
1813 if (zi.lt.buflipbot) then
1814 !C what fraction I am in
1816 ((zi-bordlipbot)/lipbufthick)
1817 !C lipbufthick is thickenes of lipid buffore
1818 sslipi=sscalelip(fracinbuf)
1819 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1820 elseif (zi.gt.bufliptop) then
1821 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1822 sslipi=sscalelip(fracinbuf)
1823 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1832 ! print *, sslipi,ssgradlipi
1833 dxi=dc_norm(1,nres+i)
1834 dyi=dc_norm(2,nres+i)
1835 dzi=dc_norm(3,nres+i)
1836 ! dsci_inv=dsc_inv(itypi)
1837 dsci_inv=vbld_inv(i+nres)
1838 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1839 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1841 ! Calculate SC interaction energy.
1843 do iint=1,nint_gr(i)
1844 do j=istart(i,iint),iend(i,iint)
1845 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1846 call dyn_ssbond_ene(i,j,evdwij)
1848 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1849 'evdw',i,j,evdwij,' ss'
1850 ! if (energy_dec) write (iout,*) &
1851 ! 'evdw',i,j,evdwij,' ss'
1852 do k=j+1,iend(i,iint)
1853 !C search over all next residues
1854 if (dyn_ss_mask(k)) then
1855 !C check if they are cysteins
1856 !C write(iout,*) 'k=',k
1858 !c write(iout,*) "PRZED TRI", evdwij
1859 ! evdwij_przed_tri=evdwij
1860 call triple_ssbond_ene(i,j,k,evdwij)
1861 !c if(evdwij_przed_tri.ne.evdwij) then
1862 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1865 !c write(iout,*) "PO TRI", evdwij
1866 !C call the energy function that removes the artifical triple disulfide
1867 !C bond the soubroutine is located in ssMD.F
1869 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1870 'evdw',i,j,evdwij,'tss'
1871 endif!dyn_ss_mask(k)
1875 itypj=iabs(itype(j,1))
1876 if (itypj.eq.ntyp1) cycle
1877 ! if (j.ne.78) cycle
1878 ! dscj_inv=dsc_inv(itypj)
1879 dscj_inv=vbld_inv(j+nres)
1880 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1881 ! 1.0d0/vbld(j+nres) !d
1882 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1883 sig0ij=sigma(itypi,itypj)
1884 chi1=chi(itypi,itypj)
1885 chi2=chi(itypj,itypi)
1892 alf12=0.5D0*(alf1+alf2)
1893 ! For diagnostics only!!!
1906 xj=dmod(xj,boxxsize)
1907 if (xj.lt.0) xj=xj+boxxsize
1908 yj=dmod(yj,boxysize)
1909 if (yj.lt.0) yj=yj+boxysize
1910 zj=dmod(zj,boxzsize)
1911 if (zj.lt.0) zj=zj+boxzsize
1912 ! print *,"tu",xi,yi,zi,xj,yj,zj
1913 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1914 ! this fragment set correct epsilon for lipid phase
1915 if ((zj.gt.bordlipbot) &
1916 .and.(zj.lt.bordliptop)) then
1917 !C the energy transfer exist
1918 if (zj.lt.buflipbot) then
1919 !C what fraction I am in
1921 ((zj-bordlipbot)/lipbufthick)
1922 !C lipbufthick is thickenes of lipid buffore
1923 sslipj=sscalelip(fracinbuf)
1924 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1925 elseif (zj.gt.bufliptop) then
1926 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1927 sslipj=sscalelip(fracinbuf)
1928 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1937 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1938 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1939 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1940 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1941 !------------------------------------------------
1942 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1950 xj=xj_safe+xshift*boxxsize
1951 yj=yj_safe+yshift*boxysize
1952 zj=zj_safe+zshift*boxzsize
1953 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1954 if(dist_temp.lt.dist_init) then
1964 if (subchap.eq.1) then
1973 dxj=dc_norm(1,nres+j)
1974 dyj=dc_norm(2,nres+j)
1975 dzj=dc_norm(3,nres+j)
1976 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1977 ! write (iout,*) "j",j," dc_norm",& !d
1978 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1979 ! write(iout,*)"rrij ",rrij
1980 ! write(iout,*)"xj yj zj ", xj, yj, zj
1981 ! write(iout,*)"xi yi zi ", xi, yi, zi
1982 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1983 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1985 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1986 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1987 ! print *,sss_ele_cut,sss_ele_grad,&
1988 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1989 if (sss_ele_cut.le.0.0) cycle
1990 ! Calculate angle-dependent terms of energy and contributions to their
1994 sig=sig0ij*dsqrt(sigsq)
1995 rij_shift=1.0D0/rij-sig+sig0ij
1996 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1998 ! for diagnostics; uncomment
1999 ! rij_shift=1.2*sig0ij
2000 ! I hate to put IF's in the loops, but here don't have another choice!!!!
2001 if (rij_shift.le.0.0D0) then
2003 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2004 !d & restyp(itypi,1),i,restyp(itypj,1),j,
2005 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
2009 !---------------------------------------------------------------
2010 rij_shift=1.0D0/rij_shift
2011 fac=rij_shift**expon
2013 e1=fac*fac*aa!(itypi,itypj)
2014 e2=fac*bb!(itypi,itypj)
2015 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2016 eps2der=evdwij*eps3rt
2017 eps3der=evdwij*eps2rt
2018 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
2019 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
2020 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
2021 evdwij=evdwij*eps2rt*eps3rt
2022 evdw=evdw+evdwij*sss_ele_cut
2024 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2025 epsi=bb**2/aa!(itypi,itypj)
2026 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
2027 restyp(itypi,1),i,restyp(itypj,1),j, &
2028 epsi,sigm,chi1,chi2,chip1,chip2, &
2029 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
2030 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
2034 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
2035 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
2036 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
2037 ! if (energy_dec) write (iout,*) &
2039 ! print *,"ZALAMKA", evdw
2041 ! Calculate gradient components.
2042 e1=e1*eps1*eps2rt**2*eps3rt**2
2043 fac=-expon*(e1+evdwij)*rij_shift
2046 ! print *,'before fac',fac,rij,evdwij
2047 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
2048 /sigma(itypi,itypj)*rij
2049 ! print *,'grad part scale',fac, &
2050 ! evdwij*sss_ele_grad/sss_ele_cut &
2051 ! /sigma(itypi,itypj)*rij
2053 ! Calculate the radial part of the gradient
2057 !C Calculate the radial part of the gradient
2058 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
2059 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
2060 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
2061 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
2062 gg_lipj(3)=ssgradlipj*gg_lipi(3)
2063 gg_lipi(3)=gg_lipi(3)*ssgradlipi
2065 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
2066 ! Calculate angular part of the gradient.
2072 ! print *,"ZALAMKA", evdw
2073 ! write (iout,*) "Number of loop steps in EGB:",ind
2074 !ccc energy_dec=.false.
2077 !-----------------------------------------------------------------------------
2078 subroutine egbv(evdw)
2080 ! This subroutine calculates the interaction energy of nonbonded side chains
2081 ! assuming the Gay-Berne-Vorobjev potential of interaction.
2085 ! implicit real*8 (a-h,o-z)
2086 ! include 'DIMENSIONS'
2087 ! include 'COMMON.GEO'
2088 ! include 'COMMON.VAR'
2089 ! include 'COMMON.LOCAL'
2090 ! include 'COMMON.CHAIN'
2091 ! include 'COMMON.DERIV'
2092 ! include 'COMMON.NAMES'
2093 ! include 'COMMON.INTERACT'
2094 ! include 'COMMON.IOUNITS'
2095 ! include 'COMMON.CALC'
2097 !el integer :: icall
2098 !el common /srutu/ icall
2101 integer :: iint,itypi,itypi1,itypj
2102 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
2103 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
2105 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
2108 ! if (icall.eq.0) lprn=.true.
2110 do i=iatsc_s,iatsc_e
2111 itypi=iabs(itype(i,1))
2112 if (itypi.eq.ntyp1) cycle
2113 itypi1=iabs(itype(i+1,1))
2117 dxi=dc_norm(1,nres+i)
2118 dyi=dc_norm(2,nres+i)
2119 dzi=dc_norm(3,nres+i)
2120 ! dsci_inv=dsc_inv(itypi)
2121 dsci_inv=vbld_inv(i+nres)
2123 ! Calculate SC interaction energy.
2125 do iint=1,nint_gr(i)
2126 do j=istart(i,iint),iend(i,iint)
2128 itypj=iabs(itype(j,1))
2129 if (itypj.eq.ntyp1) cycle
2130 ! dscj_inv=dsc_inv(itypj)
2131 dscj_inv=vbld_inv(j+nres)
2132 sig0ij=sigma(itypi,itypj)
2133 r0ij=r0(itypi,itypj)
2134 chi1=chi(itypi,itypj)
2135 chi2=chi(itypj,itypi)
2142 alf12=0.5D0*(alf1+alf2)
2143 ! For diagnostics only!!!
2156 dxj=dc_norm(1,nres+j)
2157 dyj=dc_norm(2,nres+j)
2158 dzj=dc_norm(3,nres+j)
2159 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2161 ! Calculate angle-dependent terms of energy and contributions to their
2165 sig=sig0ij*dsqrt(sigsq)
2166 rij_shift=1.0D0/rij-sig+r0ij
2167 ! I hate to put IF's in the loops, but here don't have another choice!!!!
2168 if (rij_shift.le.0.0D0) then
2173 !---------------------------------------------------------------
2174 rij_shift=1.0D0/rij_shift
2175 fac=rij_shift**expon
2176 e1=fac*fac*aa_aq(itypi,itypj)
2177 e2=fac*bb_aq(itypi,itypj)
2178 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2179 eps2der=evdwij*eps3rt
2180 eps3der=evdwij*eps2rt
2181 fac_augm=rrij**expon
2182 e_augm=augm(itypi,itypj)*fac_augm
2183 evdwij=evdwij*eps2rt*eps3rt
2184 evdw=evdw+evdwij+e_augm
2186 sigm=dabs(aa_aq(itypi,itypj)/&
2187 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
2188 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
2189 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
2190 restyp(itypi,1),i,restyp(itypj,1),j,&
2191 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
2192 chi1,chi2,chip1,chip2,&
2193 eps1,eps2rt**2,eps3rt**2,&
2194 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
2197 ! Calculate gradient components.
2198 e1=e1*eps1*eps2rt**2*eps3rt**2
2199 fac=-expon*(e1+evdwij)*rij_shift
2201 fac=rij*fac-2*expon*rrij*e_augm
2202 ! Calculate the radial part of the gradient
2206 ! Calculate angular part of the gradient.
2212 !-----------------------------------------------------------------------------
2213 !el subroutine sc_angular in module geometry
2214 !-----------------------------------------------------------------------------
2215 subroutine e_softsphere(evdw)
2217 ! This subroutine calculates the interaction energy of nonbonded side chains
2218 ! assuming the LJ potential of interaction.
2220 ! implicit real*8 (a-h,o-z)
2221 ! include 'DIMENSIONS'
2222 real(kind=8),parameter :: accur=1.0d-10
2223 ! include 'COMMON.GEO'
2224 ! include 'COMMON.VAR'
2225 ! include 'COMMON.LOCAL'
2226 ! include 'COMMON.CHAIN'
2227 ! include 'COMMON.DERIV'
2228 ! include 'COMMON.INTERACT'
2229 ! include 'COMMON.TORSION'
2230 ! include 'COMMON.SBRIDGE'
2231 ! include 'COMMON.NAMES'
2232 ! include 'COMMON.IOUNITS'
2233 ! include 'COMMON.CONTACTS'
2234 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
2235 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2237 integer :: i,iint,j,itypi,itypi1,itypj,k
2238 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
2242 do i=iatsc_s,iatsc_e
2243 itypi=iabs(itype(i,1))
2244 if (itypi.eq.ntyp1) cycle
2245 itypi1=iabs(itype(i+1,1))
2250 ! Calculate SC interaction energy.
2252 do iint=1,nint_gr(i)
2253 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2254 !d & 'iend=',iend(i,iint)
2255 do j=istart(i,iint),iend(i,iint)
2256 itypj=iabs(itype(j,1))
2257 if (itypj.eq.ntyp1) cycle
2261 rij=xj*xj+yj*yj+zj*zj
2262 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2263 r0ij=r0(itypi,itypj)
2265 ! print *,i,j,r0ij,dsqrt(rij)
2266 if (rij.lt.r0ijsq) then
2267 evdwij=0.25d0*(rij-r0ijsq)**2
2275 ! Calculate the components of the gradient in DC and X
2281 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2282 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2283 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2284 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2288 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2295 end subroutine e_softsphere
2296 !-----------------------------------------------------------------------------
2297 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2299 ! Soft-sphere potential of p-p interaction
2301 ! implicit real*8 (a-h,o-z)
2302 ! include 'DIMENSIONS'
2303 ! include 'COMMON.CONTROL'
2304 ! include 'COMMON.IOUNITS'
2305 ! include 'COMMON.GEO'
2306 ! include 'COMMON.VAR'
2307 ! include 'COMMON.LOCAL'
2308 ! include 'COMMON.CHAIN'
2309 ! include 'COMMON.DERIV'
2310 ! include 'COMMON.INTERACT'
2311 ! include 'COMMON.CONTACTS'
2312 ! include 'COMMON.TORSION'
2313 ! include 'COMMON.VECTORS'
2314 ! include 'COMMON.FFIELD'
2315 real(kind=8),dimension(3) :: ggg
2316 !d write(iout,*) 'In EELEC_soft_sphere'
2318 integer :: i,j,k,num_conti,iteli,itelj
2319 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2320 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
2321 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
2329 do i=iatel_s,iatel_e
2330 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2334 xmedi=c(1,i)+0.5d0*dxi
2335 ymedi=c(2,i)+0.5d0*dyi
2336 zmedi=c(3,i)+0.5d0*dzi
2338 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2339 do j=ielstart(i),ielend(i)
2340 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
2344 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2345 r0ij=rpp(iteli,itelj)
2350 xj=c(1,j)+0.5D0*dxj-xmedi
2351 yj=c(2,j)+0.5D0*dyj-ymedi
2352 zj=c(3,j)+0.5D0*dzj-zmedi
2353 rij=xj*xj+yj*yj+zj*zj
2354 if (rij.lt.r0ijsq) then
2355 evdw1ij=0.25d0*(rij-r0ijsq)**2
2363 ! Calculate contributions to the Cartesian gradient.
2369 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2370 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2373 ! Loop over residues i+1 thru j-1.
2377 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2382 !grad do i=nnt,nct-1
2384 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2386 !grad do j=i+1,nct-1
2388 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
2393 end subroutine eelec_soft_sphere
2394 !-----------------------------------------------------------------------------
2395 subroutine vec_and_deriv
2396 ! implicit real*8 (a-h,o-z)
2397 ! include 'DIMENSIONS'
2401 ! include 'COMMON.IOUNITS'
2402 ! include 'COMMON.GEO'
2403 ! include 'COMMON.VAR'
2404 ! include 'COMMON.LOCAL'
2405 ! include 'COMMON.CHAIN'
2406 ! include 'COMMON.VECTORS'
2407 ! include 'COMMON.SETUP'
2408 ! include 'COMMON.TIME1'
2409 real(kind=8),dimension(3,3,2) :: uyder,uzder
2410 real(kind=8),dimension(2) :: vbld_inv_temp
2411 ! Compute the local reference systems. For reference system (i), the
2412 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
2413 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2416 real(kind=8) :: facy,fac,costh
2419 do i=ivec_start,ivec_end
2423 if (i.eq.nres-1) then
2424 ! Case of the last full residue
2425 ! Compute the Z-axis
2426 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2427 costh=dcos(pi-theta(nres))
2428 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2432 ! Compute the derivatives of uz
2434 uzder(2,1,1)=-dc_norm(3,i-1)
2435 uzder(3,1,1)= dc_norm(2,i-1)
2436 uzder(1,2,1)= dc_norm(3,i-1)
2438 uzder(3,2,1)=-dc_norm(1,i-1)
2439 uzder(1,3,1)=-dc_norm(2,i-1)
2440 uzder(2,3,1)= dc_norm(1,i-1)
2443 uzder(2,1,2)= dc_norm(3,i)
2444 uzder(3,1,2)=-dc_norm(2,i)
2445 uzder(1,2,2)=-dc_norm(3,i)
2447 uzder(3,2,2)= dc_norm(1,i)
2448 uzder(1,3,2)= dc_norm(2,i)
2449 uzder(2,3,2)=-dc_norm(1,i)
2451 ! Compute the Y-axis
2454 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2456 ! Compute the derivatives of uy
2459 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2460 -dc_norm(k,i)*dc_norm(j,i-1)
2461 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2463 uyder(j,j,1)=uyder(j,j,1)-costh
2464 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2469 uygrad(l,k,j,i)=uyder(l,k,j)
2470 uzgrad(l,k,j,i)=uzder(l,k,j)
2474 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2475 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2476 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2477 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2480 ! Compute the Z-axis
2481 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2482 costh=dcos(pi-theta(i+2))
2483 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2487 ! Compute the derivatives of uz
2489 uzder(2,1,1)=-dc_norm(3,i+1)
2490 uzder(3,1,1)= dc_norm(2,i+1)
2491 uzder(1,2,1)= dc_norm(3,i+1)
2493 uzder(3,2,1)=-dc_norm(1,i+1)
2494 uzder(1,3,1)=-dc_norm(2,i+1)
2495 uzder(2,3,1)= dc_norm(1,i+1)
2498 uzder(2,1,2)= dc_norm(3,i)
2499 uzder(3,1,2)=-dc_norm(2,i)
2500 uzder(1,2,2)=-dc_norm(3,i)
2502 uzder(3,2,2)= dc_norm(1,i)
2503 uzder(1,3,2)= dc_norm(2,i)
2504 uzder(2,3,2)=-dc_norm(1,i)
2506 ! Compute the Y-axis
2509 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2511 ! Compute the derivatives of uy
2514 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2515 -dc_norm(k,i)*dc_norm(j,i+1)
2516 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2518 uyder(j,j,1)=uyder(j,j,1)-costh
2519 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2524 uygrad(l,k,j,i)=uyder(l,k,j)
2525 uzgrad(l,k,j,i)=uzder(l,k,j)
2529 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2530 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2531 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2532 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2536 vbld_inv_temp(1)=vbld_inv(i+1)
2537 if (i.lt.nres-1) then
2538 vbld_inv_temp(2)=vbld_inv(i+2)
2540 vbld_inv_temp(2)=vbld_inv(i)
2545 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2546 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2551 #if defined(PARVEC) && defined(MPI)
2552 if (nfgtasks1.gt.1) then
2554 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2555 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2556 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2557 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2558 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2560 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2561 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2563 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2564 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2565 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2566 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2567 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2568 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2569 time_gather=time_gather+MPI_Wtime()-time00
2571 ! if (fg_rank.eq.0) then
2572 ! write (iout,*) "Arrays UY and UZ"
2574 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2580 end subroutine vec_and_deriv
2581 !-----------------------------------------------------------------------------
2582 subroutine check_vecgrad
2583 ! implicit real*8 (a-h,o-z)
2584 ! include 'DIMENSIONS'
2585 ! include 'COMMON.IOUNITS'
2586 ! include 'COMMON.GEO'
2587 ! include 'COMMON.VAR'
2588 ! include 'COMMON.LOCAL'
2589 ! include 'COMMON.CHAIN'
2590 ! include 'COMMON.VECTORS'
2591 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2592 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2593 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2594 real(kind=8),dimension(3) :: erij
2595 real(kind=8) :: delta=1.0d-7
2601 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2602 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2603 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2604 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2605 !d & (dc_norm(if90,i),if90=1,3)
2606 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2607 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2608 !d write(iout,'(a)')
2614 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2615 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2628 !d write (iout,*) 'i=',i
2630 erij(k)=dc_norm(k,i)
2634 dc_norm(k,i)=erij(k)
2636 dc_norm(j,i)=dc_norm(j,i)+delta
2637 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2639 ! dc_norm(k,i)=dc_norm(k,i)/fac
2641 ! write (iout,*) (dc_norm(k,i),k=1,3)
2642 ! write (iout,*) (erij(k),k=1,3)
2645 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2646 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2647 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2648 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2650 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2651 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2652 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2655 dc_norm(k,i)=erij(k)
2658 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2659 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2660 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2661 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2662 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2663 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2664 !d write (iout,'(a)')
2668 end subroutine check_vecgrad
2669 !-----------------------------------------------------------------------------
2670 subroutine set_matrices
2671 ! implicit real*8 (a-h,o-z)
2672 ! include 'DIMENSIONS'
2675 ! include "COMMON.SETUP"
2677 integer :: status(MPI_STATUS_SIZE)
2679 ! include 'COMMON.IOUNITS'
2680 ! include 'COMMON.GEO'
2681 ! include 'COMMON.VAR'
2682 ! include 'COMMON.LOCAL'
2683 ! include 'COMMON.CHAIN'
2684 ! include 'COMMON.DERIV'
2685 ! include 'COMMON.INTERACT'
2686 ! include 'COMMON.CONTACTS'
2687 ! include 'COMMON.TORSION'
2688 ! include 'COMMON.VECTORS'
2689 ! include 'COMMON.FFIELD'
2690 real(kind=8) :: auxvec(2),auxmat(2,2)
2691 integer :: i,iti1,iti,k,l
2692 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2693 ! print *,"in set matrices"
2695 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2696 ! to calculate the el-loc multibody terms of various order.
2700 do i=ivec_start+2,ivec_end+2
2705 if (i .lt. nres+1) then
2742 if (i .gt. 3 .and. i .lt. nres+1) then
2743 obrot_der(1,i-2)=-sin1
2744 obrot_der(2,i-2)= cos1
2745 Ugder(1,1,i-2)= sin1
2746 Ugder(1,2,i-2)=-cos1
2747 Ugder(2,1,i-2)=-cos1
2748 Ugder(2,2,i-2)=-sin1
2751 obrot2_der(1,i-2)=-dwasin2
2752 obrot2_der(2,i-2)= dwacos2
2753 Ug2der(1,1,i-2)= dwasin2
2754 Ug2der(1,2,i-2)=-dwacos2
2755 Ug2der(2,1,i-2)=-dwacos2
2756 Ug2der(2,2,i-2)=-dwasin2
2758 obrot_der(1,i-2)=0.0d0
2759 obrot_der(2,i-2)=0.0d0
2760 Ugder(1,1,i-2)=0.0d0
2761 Ugder(1,2,i-2)=0.0d0
2762 Ugder(2,1,i-2)=0.0d0
2763 Ugder(2,2,i-2)=0.0d0
2764 obrot2_der(1,i-2)=0.0d0
2765 obrot2_der(2,i-2)=0.0d0
2766 Ug2der(1,1,i-2)=0.0d0
2767 Ug2der(1,2,i-2)=0.0d0
2768 Ug2der(2,1,i-2)=0.0d0
2769 Ug2der(2,2,i-2)=0.0d0
2771 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2772 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2773 if (itype(i-2,1).eq.0) then
2776 iti = itortyp(itype(i-2,1))
2781 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2782 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2783 if (itype(i-1,1).eq.0) then
2786 iti1 = itortyp(itype(i-1,1))
2791 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
2792 !d write (iout,*) '*******i',i,' iti1',iti
2793 !d write (iout,*) 'b1',b1(:,iti)
2794 !d write (iout,*) 'b2',b2(:,iti)
2795 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2796 ! if (i .gt. iatel_s+2) then
2797 if (i .gt. nnt+2) then
2798 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2799 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2800 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2802 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2803 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2804 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2805 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2806 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2817 DtUg2(l,k,i-2)=0.0d0
2821 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2822 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2824 muder(k,i-2)=Ub2der(k,i-2)
2826 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2827 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2828 if (itype(i-1,1).eq.0) then
2830 elseif (itype(i-1,1).le.ntyp) then
2831 iti1 = itortyp(itype(i-1,1))
2839 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2841 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2842 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2843 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2844 !d write (iout,*) 'mu1',mu1(:,i-2)
2845 !d write (iout,*) 'mu2',mu2(:,i-2)
2846 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2848 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2849 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2850 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2851 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2852 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2853 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2854 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2855 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2856 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2857 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2858 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2859 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2860 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2861 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2862 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2865 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2866 ! The order of matrices is from left to right.
2867 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2869 ! do i=max0(ivec_start,2),ivec_end
2871 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2872 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2873 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2874 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2875 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2876 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2877 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2878 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2881 #if defined(MPI) && defined(PARMAT)
2883 ! if (fg_rank.eq.0) then
2884 write (iout,*) "Arrays UG and UGDER before GATHER"
2886 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2887 ((ug(l,k,i),l=1,2),k=1,2),&
2888 ((ugder(l,k,i),l=1,2),k=1,2)
2890 write (iout,*) "Arrays UG2 and UG2DER"
2892 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2893 ((ug2(l,k,i),l=1,2),k=1,2),&
2894 ((ug2der(l,k,i),l=1,2),k=1,2)
2896 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2898 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2899 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2900 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2902 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2904 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2905 costab(i),sintab(i),costab2(i),sintab2(i)
2907 write (iout,*) "Array MUDER"
2909 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2913 if (nfgtasks.gt.1) then
2915 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2916 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2917 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2919 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2920 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2922 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2923 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2925 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2926 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2928 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2929 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2931 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2932 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2934 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2935 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2937 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2938 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2939 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2940 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2941 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2942 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2943 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2944 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2945 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2946 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2947 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2948 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2949 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2951 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2952 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2954 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2955 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2957 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2958 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2960 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2961 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2963 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2964 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2966 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2967 ivec_count(fg_rank1),&
2968 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2970 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2971 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2973 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2974 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2976 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2977 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2979 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2980 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2982 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2983 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2985 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2986 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2988 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2989 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2991 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2992 ivec_count(fg_rank1),&
2993 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2995 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2996 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2998 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2999 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3001 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
3002 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3004 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
3005 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3007 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
3008 ivec_count(fg_rank1),&
3009 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3011 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
3012 ivec_count(fg_rank1),&
3013 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3015 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
3016 ivec_count(fg_rank1),&
3017 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
3018 MPI_MAT2,FG_COMM1,IERR)
3019 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
3020 ivec_count(fg_rank1),&
3021 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
3022 MPI_MAT2,FG_COMM1,IERR)
3025 ! Passes matrix info through the ring
3028 if (irecv.lt.0) irecv=nfgtasks1-1
3031 if (inext.ge.nfgtasks1) inext=0
3033 ! write (iout,*) "isend",isend," irecv",irecv
3035 lensend=lentyp(isend)
3036 lenrecv=lentyp(irecv)
3037 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
3038 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3039 ! & MPI_ROTAT1(lensend),inext,2200+isend,
3040 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3041 ! & iprev,2200+irecv,FG_COMM,status,IERR)
3042 ! write (iout,*) "Gather ROTAT1"
3044 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3045 ! & MPI_ROTAT2(lensend),inext,3300+isend,
3046 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3047 ! & iprev,3300+irecv,FG_COMM,status,IERR)
3048 ! write (iout,*) "Gather ROTAT2"
3050 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
3051 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
3052 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
3053 iprev,4400+irecv,FG_COMM,status,IERR)
3054 ! write (iout,*) "Gather ROTAT_OLD"
3056 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
3057 MPI_PRECOMP11(lensend),inext,5500+isend,&
3058 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
3059 iprev,5500+irecv,FG_COMM,status,IERR)
3060 ! write (iout,*) "Gather PRECOMP11"
3062 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
3063 MPI_PRECOMP12(lensend),inext,6600+isend,&
3064 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
3065 iprev,6600+irecv,FG_COMM,status,IERR)
3066 ! write (iout,*) "Gather PRECOMP12"
3068 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
3070 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
3071 MPI_ROTAT2(lensend),inext,7700+isend,&
3072 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
3073 iprev,7700+irecv,FG_COMM,status,IERR)
3074 ! write (iout,*) "Gather PRECOMP21"
3076 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
3077 MPI_PRECOMP22(lensend),inext,8800+isend,&
3078 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
3079 iprev,8800+irecv,FG_COMM,status,IERR)
3080 ! write (iout,*) "Gather PRECOMP22"
3082 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
3083 MPI_PRECOMP23(lensend),inext,9900+isend,&
3084 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
3085 MPI_PRECOMP23(lenrecv),&
3086 iprev,9900+irecv,FG_COMM,status,IERR)
3087 ! write (iout,*) "Gather PRECOMP23"
3092 if (irecv.lt.0) irecv=nfgtasks1-1
3095 time_gather=time_gather+MPI_Wtime()-time00
3098 ! if (fg_rank.eq.0) then
3099 write (iout,*) "Arrays UG and UGDER"
3101 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3102 ((ug(l,k,i),l=1,2),k=1,2),&
3103 ((ugder(l,k,i),l=1,2),k=1,2)
3105 write (iout,*) "Arrays UG2 and UG2DER"
3107 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3108 ((ug2(l,k,i),l=1,2),k=1,2),&
3109 ((ug2der(l,k,i),l=1,2),k=1,2)
3111 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3113 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3114 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
3115 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3117 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3119 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3120 costab(i),sintab(i),costab2(i),sintab2(i)
3122 write (iout,*) "Array MUDER"
3124 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3130 !d iti = itortyp(itype(i,1))
3133 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3134 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3138 end subroutine set_matrices
3139 !-----------------------------------------------------------------------------
3140 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3142 ! This subroutine calculates the average interaction energy and its gradient
3143 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
3144 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3145 ! The potential depends both on the distance of peptide-group centers and on
3146 ! the orientation of the CA-CA virtual bonds.
3149 ! implicit real*8 (a-h,o-z)
3153 ! include 'DIMENSIONS'
3154 ! include 'COMMON.CONTROL'
3155 ! include 'COMMON.SETUP'
3156 ! include 'COMMON.IOUNITS'
3157 ! include 'COMMON.GEO'
3158 ! include 'COMMON.VAR'
3159 ! include 'COMMON.LOCAL'
3160 ! include 'COMMON.CHAIN'
3161 ! include 'COMMON.DERIV'
3162 ! include 'COMMON.INTERACT'
3163 ! include 'COMMON.CONTACTS'
3164 ! include 'COMMON.TORSION'
3165 ! include 'COMMON.VECTORS'
3166 ! include 'COMMON.FFIELD'
3167 ! include 'COMMON.TIME1'
3168 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
3169 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3170 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3171 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3172 real(kind=8),dimension(4) :: muij
3173 !el integer :: num_conti,j1,j2
3174 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3175 !el dz_normi,xmedi,ymedi,zmedi
3177 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3178 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3181 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3183 real(kind=8) :: scal_el=1.0d0
3185 real(kind=8) :: scal_el=0.5d0
3188 ! 13-go grudnia roku pamietnego...
3189 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3191 0.0d0,0.0d0,1.0d0/),shape(unmat))
3194 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
3195 real(kind=8) :: fac,t_eelecij,fracinbuf
3198 !d write(iout,*) 'In EELEC'
3199 ! print *,"IN EELEC"
3201 !d write(iout,*) 'Type',i
3202 !d write(iout,*) 'B1',B1(:,i)
3203 !d write(iout,*) 'B2',B2(:,i)
3204 !d write(iout,*) 'CC',CC(:,:,i)
3205 !d write(iout,*) 'DD',DD(:,:,i)
3206 !d write(iout,*) 'EE',EE(:,:,i)
3208 !d call check_vecgrad
3223 if (icheckgrad.eq.1) then
3226 ! dc_norm(1,i)=0.0d0
3227 ! dc_norm(2,i)=0.0d0
3228 ! dc_norm(3,i)=0.0d0
3231 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3233 dc_norm(k,i)=dc(k,i)*fac
3235 ! write (iout,*) 'i',i,' fac',fac
3238 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
3240 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3241 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
3242 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3243 ! call vec_and_deriv
3247 ! print *, "before set matrices"
3249 ! print *, "after set matrices"
3252 time_mat=time_mat+MPI_Wtime()-time01
3255 ! print *, "after set matrices"
3257 !d write (iout,*) 'i=',i
3259 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3262 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3263 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3276 !d print '(a)','Enter EELEC'
3277 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3278 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
3279 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
3281 gel_loc_loc(i)=0.0d0
3286 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3288 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
3292 ! print *,"before iturn3 loop"
3293 do i=iturn3_start,iturn3_end
3294 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3295 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
3299 dx_normi=dc_norm(1,i)
3300 dy_normi=dc_norm(2,i)
3301 dz_normi=dc_norm(3,i)
3302 xmedi=c(1,i)+0.5d0*dxi
3303 ymedi=c(2,i)+0.5d0*dyi
3304 zmedi=c(3,i)+0.5d0*dzi
3305 xmedi=dmod(xmedi,boxxsize)
3306 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3307 ymedi=dmod(ymedi,boxysize)
3308 if (ymedi.lt.0) ymedi=ymedi+boxysize
3309 zmedi=dmod(zmedi,boxzsize)
3310 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3312 if ((zmedi.gt.bordlipbot) &
3313 .and.(zmedi.lt.bordliptop)) then
3314 !C the energy transfer exist
3315 if (zmedi.lt.buflipbot) then
3316 !C what fraction I am in
3318 ((zmedi-bordlipbot)/lipbufthick)
3319 !C lipbufthick is thickenes of lipid buffore
3320 sslipi=sscalelip(fracinbuf)
3321 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3322 elseif (zmedi.gt.bufliptop) then
3323 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3324 sslipi=sscalelip(fracinbuf)
3325 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3334 ! print *,i,sslipi,ssgradlipi
3335 call eelecij(i,i+2,ees,evdw1,eel_loc)
3336 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3337 num_cont_hb(i)=num_conti
3339 do i=iturn4_start,iturn4_end
3340 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3341 .or. itype(i+3,1).eq.ntyp1 &
3342 .or. itype(i+4,1).eq.ntyp1) cycle
3343 ! print *,"before2",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
3347 dx_normi=dc_norm(1,i)
3348 dy_normi=dc_norm(2,i)
3349 dz_normi=dc_norm(3,i)
3350 xmedi=c(1,i)+0.5d0*dxi
3351 ymedi=c(2,i)+0.5d0*dyi
3352 zmedi=c(3,i)+0.5d0*dzi
3353 xmedi=dmod(xmedi,boxxsize)
3354 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3355 ymedi=dmod(ymedi,boxysize)
3356 if (ymedi.lt.0) ymedi=ymedi+boxysize
3357 zmedi=dmod(zmedi,boxzsize)
3358 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3359 if ((zmedi.gt.bordlipbot) &
3360 .and.(zmedi.lt.bordliptop)) then
3361 !C the energy transfer exist
3362 if (zmedi.lt.buflipbot) then
3363 !C what fraction I am in
3365 ((zmedi-bordlipbot)/lipbufthick)
3366 !C lipbufthick is thickenes of lipid buffore
3367 sslipi=sscalelip(fracinbuf)
3368 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3369 elseif (zmedi.gt.bufliptop) then
3370 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3371 sslipi=sscalelip(fracinbuf)
3372 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3382 num_conti=num_cont_hb(i)
3383 call eelecij(i,i+3,ees,evdw1,eel_loc)
3384 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
3385 call eturn4(i,eello_turn4)
3386 ! print *,"before",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
3387 num_cont_hb(i)=num_conti
3390 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3392 ! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
3393 do i=iatel_s,iatel_e
3394 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
3398 dx_normi=dc_norm(1,i)
3399 dy_normi=dc_norm(2,i)
3400 dz_normi=dc_norm(3,i)
3401 xmedi=c(1,i)+0.5d0*dxi
3402 ymedi=c(2,i)+0.5d0*dyi
3403 zmedi=c(3,i)+0.5d0*dzi
3404 xmedi=dmod(xmedi,boxxsize)
3405 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3406 ymedi=dmod(ymedi,boxysize)
3407 if (ymedi.lt.0) ymedi=ymedi+boxysize
3408 zmedi=dmod(zmedi,boxzsize)
3409 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3410 if ((zmedi.gt.bordlipbot) &
3411 .and.(zmedi.lt.bordliptop)) then
3412 !C the energy transfer exist
3413 if (zmedi.lt.buflipbot) then
3414 !C what fraction I am in
3416 ((zmedi-bordlipbot)/lipbufthick)
3417 !C lipbufthick is thickenes of lipid buffore
3418 sslipi=sscalelip(fracinbuf)
3419 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3420 elseif (zmedi.gt.bufliptop) then
3421 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3422 sslipi=sscalelip(fracinbuf)
3423 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3433 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3434 num_conti=num_cont_hb(i)
3435 do j=ielstart(i),ielend(i)
3436 ! write (iout,*) i,j,itype(i,1),itype(j,1)
3437 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
3438 call eelecij(i,j,ees,evdw1,eel_loc)
3440 num_cont_hb(i)=num_conti
3442 ! write (iout,*) "Number of loop steps in EELEC:",ind
3444 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3445 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3447 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3448 !cc eel_loc=eel_loc+eello_turn3
3449 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3451 end subroutine eelec
3452 !-----------------------------------------------------------------------------
3453 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3456 ! implicit real*8 (a-h,o-z)
3457 ! include 'DIMENSIONS'
3461 ! include 'COMMON.CONTROL'
3462 ! include 'COMMON.IOUNITS'
3463 ! include 'COMMON.GEO'
3464 ! include 'COMMON.VAR'
3465 ! include 'COMMON.LOCAL'
3466 ! include 'COMMON.CHAIN'
3467 ! include 'COMMON.DERIV'
3468 ! include 'COMMON.INTERACT'
3469 ! include 'COMMON.CONTACTS'
3470 ! include 'COMMON.TORSION'
3471 ! include 'COMMON.VECTORS'
3472 ! include 'COMMON.FFIELD'
3473 ! include 'COMMON.TIME1'
3474 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3475 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3476 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3477 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3478 real(kind=8),dimension(4) :: muij
3479 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3480 dist_temp, dist_init,rlocshield,fracinbuf
3481 integer xshift,yshift,zshift,ilist,iresshield
3482 !el integer :: num_conti,j1,j2
3483 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3484 !el dz_normi,xmedi,ymedi,zmedi
3486 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3487 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3490 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3492 real(kind=8) :: scal_el=1.0d0
3494 real(kind=8) :: scal_el=0.5d0
3497 ! 13-go grudnia roku pamietnego...
3498 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3500 0.0d0,0.0d0,1.0d0/),shape(unmat))
3501 ! integer :: maxconts=nres/4
3503 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3504 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3505 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3506 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3507 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3508 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3509 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3510 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3511 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3512 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3513 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3515 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3516 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3518 ! time00=MPI_Wtime()
3519 !d write (iout,*) "eelecij",i,j
3523 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3524 aaa=app(iteli,itelj)
3525 bbb=bpp(iteli,itelj)
3526 ael6i=ael6(iteli,itelj)
3527 ael3i=ael3(iteli,itelj)
3531 dx_normj=dc_norm(1,j)
3532 dy_normj=dc_norm(2,j)
3533 dz_normj=dc_norm(3,j)
3534 ! xj=c(1,j)+0.5D0*dxj-xmedi
3535 ! yj=c(2,j)+0.5D0*dyj-ymedi
3536 ! zj=c(3,j)+0.5D0*dzj-zmedi
3541 if (xj.lt.0) xj=xj+boxxsize
3543 if (yj.lt.0) yj=yj+boxysize
3545 if (zj.lt.0) zj=zj+boxzsize
3546 if ((zj.gt.bordlipbot) &
3547 .and.(zj.lt.bordliptop)) then
3548 !C the energy transfer exist
3549 if (zj.lt.buflipbot) then
3550 !C what fraction I am in
3552 ((zj-bordlipbot)/lipbufthick)
3553 !C lipbufthick is thickenes of lipid buffore
3554 sslipj=sscalelip(fracinbuf)
3555 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3556 elseif (zj.gt.bufliptop) then
3557 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3558 sslipj=sscalelip(fracinbuf)
3559 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3570 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3577 xj=xj_safe+xshift*boxxsize
3578 yj=yj_safe+yshift*boxysize
3579 zj=zj_safe+zshift*boxzsize
3580 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3581 if(dist_temp.lt.dist_init) then
3591 if (isubchap.eq.1) then
3602 rij=xj*xj+yj*yj+zj*zj
3605 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3606 sss_ele_cut=sscale_ele(rij)
3607 sss_ele_grad=sscagrad_ele(rij)
3609 ! sss_ele_grad=0.0d0
3610 ! print *,sss_ele_cut,sss_ele_grad,&
3611 ! (rij),r_cut_ele,rlamb_ele
3612 ! if (sss_ele_cut.le.0.0) go to 128
3617 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3618 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3619 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3620 fac=cosa-3.0D0*cosb*cosg
3622 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3623 if (j.eq.i+2) ev1=scal_el*ev1
3628 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3631 if (shield_mode.gt.0) then
3632 !C fac_shield(i)=0.4
3633 !C fac_shield(j)=0.6
3634 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3635 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3637 ees=ees+eesij*sss_ele_cut
3638 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3639 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3645 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3646 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3649 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3650 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3651 ! ees=ees+eesij*sss_ele_cut
3652 evdw1=evdw1+evdwij*sss_ele_cut &
3653 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3654 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3655 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3656 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3657 !d & xmedi,ymedi,zmedi,xj,yj,zj
3659 if (energy_dec) then
3660 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3661 ! 'evdw1',i,j,evdwij,&
3662 ! iteli,itelj,aaa,evdw1
3663 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3664 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3667 ! Calculate contributions to the Cartesian gradient.
3670 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3671 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3672 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3673 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3679 ! Radial derivatives. First process both termini of the fragment (i,j)
3681 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3682 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3683 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3684 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3685 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3686 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3688 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3689 (shield_mode.gt.0)) then
3691 do ilist=1,ishield_list(i)
3692 iresshield=shield_list(ilist,i)
3694 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3696 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3698 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3700 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3703 do ilist=1,ishield_list(j)
3704 iresshield=shield_list(ilist,j)
3706 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3708 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3710 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3712 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3716 gshieldc(k,i)=gshieldc(k,i)+ &
3717 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3720 gshieldc(k,j)=gshieldc(k,j)+ &
3721 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3724 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3725 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3728 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3729 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3737 ! ghalf=0.5D0*ggg(k)
3738 ! gelc(k,i)=gelc(k,i)+ghalf
3739 ! gelc(k,j)=gelc(k,j)+ghalf
3741 ! 9/28/08 AL Gradient compotents will be summed only at the end
3743 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3744 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3746 gelc_long(3,j)=gelc_long(3,j)+ &
3747 ssgradlipj*eesij/2.0d0*lipscale**2&
3750 gelc_long(3,i)=gelc_long(3,i)+ &
3751 ssgradlipi*eesij/2.0d0*lipscale**2&
3756 ! Loop over residues i+1 thru j-1.
3760 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3763 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3764 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3765 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3766 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3767 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3768 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3771 ! ghalf=0.5D0*ggg(k)
3772 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3773 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3775 ! 9/28/08 AL Gradient compotents will be summed only at the end
3777 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3778 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3781 !C Lipidic part for scaling weight
3782 gvdwpp(3,j)=gvdwpp(3,j)+ &
3783 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3784 gvdwpp(3,i)=gvdwpp(3,i)+ &
3785 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3786 !! Loop over residues i+1 thru j-1.
3790 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3794 facvdw=(ev1+evdwij)*sss_ele_cut &
3795 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3797 facel=(el1+eesij)*sss_ele_cut
3799 fac=-3*rrmij*(facvdw+facvdw+facel)
3804 ! Radial derivatives. First process both termini of the fragment (i,j)
3806 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3807 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3808 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3810 ! ghalf=0.5D0*ggg(k)
3811 ! gelc(k,i)=gelc(k,i)+ghalf
3812 ! gelc(k,j)=gelc(k,j)+ghalf
3814 ! 9/28/08 AL Gradient compotents will be summed only at the end
3816 gelc_long(k,j)=gelc(k,j)+ggg(k)
3817 gelc_long(k,i)=gelc(k,i)-ggg(k)
3820 ! Loop over residues i+1 thru j-1.
3824 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3827 ! 9/28/08 AL Gradient compotents will be summed only at the end
3829 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3831 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3833 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3836 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3837 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3839 gvdwpp(3,j)=gvdwpp(3,j)+ &
3840 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3841 gvdwpp(3,i)=gvdwpp(3,i)+ &
3842 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3848 ecosa=2.0D0*fac3*fac1+fac4
3851 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3852 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3854 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3855 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3857 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3858 !d & (dcosg(k),k=1,3)
3860 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3861 *fac_shield(i)**2*fac_shield(j)**2 &
3862 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3866 ! ghalf=0.5D0*ggg(k)
3867 ! gelc(k,i)=gelc(k,i)+ghalf
3868 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3869 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3870 ! gelc(k,j)=gelc(k,j)+ghalf
3871 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3872 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3876 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3880 gelc(k,i)=gelc(k,i) &
3881 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3882 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3884 *fac_shield(i)**2*fac_shield(j)**2 &
3885 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3887 gelc(k,j)=gelc(k,j) &
3888 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3889 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3891 *fac_shield(i)**2*fac_shield(j)**2 &
3892 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3894 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3895 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3898 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3899 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3900 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3902 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3903 ! energy of a peptide unit is assumed in the form of a second-order
3904 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3905 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3906 ! are computed for EVERY pair of non-contiguous peptide groups.
3908 if (j.lt.nres-1) then
3919 muij(kkk)=mu(k,i)*mu(l,j)
3922 !d write (iout,*) 'EELEC: i',i,' j',j
3923 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3924 !d write(iout,*) 'muij',muij
3925 ury=scalar(uy(1,i),erij)
3926 urz=scalar(uz(1,i),erij)
3927 vry=scalar(uy(1,j),erij)
3928 vrz=scalar(uz(1,j),erij)
3929 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3930 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3931 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3932 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3933 fac=dsqrt(-ael6i)*r3ij
3938 !d write (iout,'(4i5,4f10.5)')
3939 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
3940 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3941 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3942 !d & uy(:,j),uz(:,j)
3943 !d write (iout,'(4f10.5)')
3944 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3945 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3946 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3947 !d write (iout,'(9f10.5/)')
3948 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3949 ! Derivatives of the elements of A in virtual-bond vectors
3950 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3952 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3953 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3954 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3955 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3956 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3957 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3958 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3959 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3960 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3961 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3962 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3963 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3965 ! Compute radial contributions to the gradient
3983 ! Add the contributions coming from er
3986 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3987 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3988 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3989 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3992 ! Derivatives in DC(i)
3993 !grad ghalf1=0.5d0*agg(k,1)
3994 !grad ghalf2=0.5d0*agg(k,2)
3995 !grad ghalf3=0.5d0*agg(k,3)
3996 !grad ghalf4=0.5d0*agg(k,4)
3997 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3998 -3.0d0*uryg(k,2)*vry)!+ghalf1
3999 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
4000 -3.0d0*uryg(k,2)*vrz)!+ghalf2
4001 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
4002 -3.0d0*urzg(k,2)*vry)!+ghalf3
4003 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
4004 -3.0d0*urzg(k,2)*vrz)!+ghalf4
4005 ! Derivatives in DC(i+1)
4006 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
4007 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4008 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
4009 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4010 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
4011 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4012 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
4013 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4014 ! Derivatives in DC(j)
4015 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
4016 -3.0d0*vryg(k,2)*ury)!+ghalf1
4017 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
4018 -3.0d0*vrzg(k,2)*ury)!+ghalf2
4019 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
4020 -3.0d0*vryg(k,2)*urz)!+ghalf3
4021 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
4022 -3.0d0*vrzg(k,2)*urz)!+ghalf4
4023 ! Derivatives in DC(j+1) or DC(nres-1)
4024 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
4025 -3.0d0*vryg(k,3)*ury)
4026 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
4027 -3.0d0*vrzg(k,3)*ury)
4028 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
4029 -3.0d0*vryg(k,3)*urz)
4030 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
4031 -3.0d0*vrzg(k,3)*urz)
4032 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
4034 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4047 aggi(k,l)=-aggi(k,l)
4048 aggi1(k,l)=-aggi1(k,l)
4049 aggj(k,l)=-aggj(k,l)
4050 aggj1(k,l)=-aggj1(k,l)
4053 if (j.lt.nres-1) then
4059 aggi(k,l)=-aggi(k,l)
4060 aggi1(k,l)=-aggi1(k,l)
4061 aggj(k,l)=-aggj(k,l)
4062 aggj1(k,l)=-aggj1(k,l)
4073 aggi(k,l)=-aggi(k,l)
4074 aggi1(k,l)=-aggi1(k,l)
4075 aggj(k,l)=-aggj(k,l)
4076 aggj1(k,l)=-aggj1(k,l)
4081 IF (wel_loc.gt.0.0d0) THEN
4082 ! Contribution to the local-electrostatic energy coming from the i-j pair
4083 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
4085 if (shield_mode.eq.0) then
4089 eel_loc_ij=eel_loc_ij &
4090 *fac_shield(i)*fac_shield(j) &
4091 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4092 !C Now derivative over eel_loc
4093 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4094 (shield_mode.gt.0)) then
4097 do ilist=1,ishield_list(i)
4098 iresshield=shield_list(ilist,i)
4100 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
4103 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
4105 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
4108 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
4112 do ilist=1,ishield_list(j)
4113 iresshield=shield_list(ilist,j)
4115 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
4118 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
4120 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
4123 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
4130 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
4131 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
4133 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
4134 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
4136 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
4137 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
4139 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
4140 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
4147 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4149 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4150 ! 'eelloc',i,j,eel_loc_ij
4151 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,8f8.3)') &
4152 'eelloc',i,j,eel_loc_ij,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4153 ! print *,"EELLOC",i,gel_loc_loc(i-1)
4155 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
4156 ! if (energy_dec) write (iout,*) "muij",muij
4157 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
4159 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
4160 ! Partial derivatives in virtual-bond dihedral angles gamma
4162 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
4163 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
4164 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
4166 *fac_shield(i)*fac_shield(j) &
4167 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4169 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
4170 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
4171 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
4173 *fac_shield(i)*fac_shield(j) &
4174 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4175 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4177 ! ggg(1)=(agg(1,1)*muij(1)+ &
4178 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
4180 ! +eel_loc_ij*sss_ele_grad*rmij*xj
4181 ! ggg(2)=(agg(2,1)*muij(1)+ &
4182 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
4184 ! +eel_loc_ij*sss_ele_grad*rmij*yj
4185 ! ggg(3)=(agg(3,1)*muij(1)+ &
4186 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
4188 ! +eel_loc_ij*sss_ele_grad*rmij*zj
4194 ggg(l)=(agg(l,1)*muij(1)+ &
4195 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
4197 *fac_shield(i)*fac_shield(j) &
4198 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
4199 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4202 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4203 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4204 !grad ghalf=0.5d0*ggg(l)
4205 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
4206 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
4208 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
4209 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
4210 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4212 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
4213 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
4214 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4218 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4221 ! Remaining derivatives of eello
4223 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
4224 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
4226 *fac_shield(i)*fac_shield(j) &
4227 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4229 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4230 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
4231 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
4232 +aggi1(l,4)*muij(4))&
4234 *fac_shield(i)*fac_shield(j) &
4235 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4237 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4238 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
4239 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
4241 *fac_shield(i)*fac_shield(j) &
4242 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4244 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4245 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
4246 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
4247 +aggj1(l,4)*muij(4))&
4249 *fac_shield(i)*fac_shield(j) &
4250 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4252 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4255 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
4256 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
4257 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
4258 .and. num_conti.le.maxconts) then
4259 ! write (iout,*) i,j," entered corr"
4261 ! Calculate the contact function. The ith column of the array JCONT will
4262 ! contain the numbers of atoms that make contacts with the atom I (of numbers
4263 ! greater than I). The arrays FACONT and GACONT will contain the values of
4264 ! the contact function and its derivative.
4265 ! r0ij=1.02D0*rpp(iteli,itelj)
4266 ! r0ij=1.11D0*rpp(iteli,itelj)
4267 r0ij=2.20D0*rpp(iteli,itelj)
4268 ! r0ij=1.55D0*rpp(iteli,itelj)
4269 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4270 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
4271 if (fcont.gt.0.0D0) then
4272 num_conti=num_conti+1
4273 if (num_conti.gt.maxconts) then
4274 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
4275 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
4276 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
4277 ' will skip next contacts for this conf.', num_conti
4279 jcont_hb(num_conti,i)=j
4280 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
4281 !d & " jcont_hb",jcont_hb(num_conti,i)
4282 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
4283 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4284 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4286 d_cont(num_conti,i)=rij
4287 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4288 ! --- Electrostatic-interaction matrix ---
4289 a_chuj(1,1,num_conti,i)=a22
4290 a_chuj(1,2,num_conti,i)=a23
4291 a_chuj(2,1,num_conti,i)=a32
4292 a_chuj(2,2,num_conti,i)=a33
4293 ! --- Gradient of rij
4295 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4302 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4303 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4304 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4305 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4306 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4311 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4312 ! Calculate contact energies
4314 wij=cosa-3.0D0*cosb*cosg
4317 ! fac3=dsqrt(-ael6i)/r0ij**3
4318 fac3=dsqrt(-ael6i)*r3ij
4319 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4320 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4321 if (ees0tmp.gt.0) then
4322 ees0pij=dsqrt(ees0tmp)
4326 if (shield_mode.eq.0) then
4330 ees0plist(num_conti,i)=j
4332 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4333 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4334 if (ees0tmp.gt.0) then
4335 ees0mij=dsqrt(ees0tmp)
4340 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
4342 *fac_shield(i)*fac_shield(j)
4344 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
4346 *fac_shield(i)*fac_shield(j)
4348 ! Diagnostics. Comment out or remove after debugging!
4349 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4350 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4351 ! ees0m(num_conti,i)=0.0D0
4353 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4354 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4355 ! Angular derivatives of the contact function
4356 ees0pij1=fac3/ees0pij
4357 ees0mij1=fac3/ees0mij
4358 fac3p=-3.0D0*fac3*rrmij
4359 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4360 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4362 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4363 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4364 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4365 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4366 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4367 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4368 ecosap=ecosa1+ecosa2
4369 ecosbp=ecosb1+ecosb2
4370 ecosgp=ecosg1+ecosg2
4371 ecosam=ecosa1-ecosa2
4372 ecosbm=ecosb1-ecosb2
4373 ecosgm=ecosg1-ecosg2
4382 facont_hb(num_conti,i)=fcont
4383 fprimcont=fprimcont/rij
4384 !d facont_hb(num_conti,i)=1.0D0
4385 ! Following line is for diagnostics.
4388 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4389 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4392 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4393 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4395 gggp(1)=gggp(1)+ees0pijp*xj &
4396 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4397 gggp(2)=gggp(2)+ees0pijp*yj &
4398 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4399 gggp(3)=gggp(3)+ees0pijp*zj &
4400 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4402 gggm(1)=gggm(1)+ees0mijp*xj &
4403 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4405 gggm(2)=gggm(2)+ees0mijp*yj &
4406 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4408 gggm(3)=gggm(3)+ees0mijp*zj &
4409 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4411 ! Derivatives due to the contact function
4412 gacont_hbr(1,num_conti,i)=fprimcont*xj
4413 gacont_hbr(2,num_conti,i)=fprimcont*yj
4414 gacont_hbr(3,num_conti,i)=fprimcont*zj
4417 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
4418 ! following the change of gradient-summation algorithm.
4420 !grad ghalfp=0.5D0*gggp(k)
4421 !grad ghalfm=0.5D0*gggm(k)
4422 gacontp_hb1(k,num_conti,i)= & !ghalfp+
4423 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4424 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4425 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4427 gacontp_hb2(k,num_conti,i)= & !ghalfp+
4428 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4429 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4430 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4432 gacontp_hb3(k,num_conti,i)=gggp(k) &
4433 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4435 gacontm_hb1(k,num_conti,i)= & !ghalfm+
4436 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4437 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4438 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4440 gacontm_hb2(k,num_conti,i)= & !ghalfm+
4441 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4442 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
4443 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4445 gacontm_hb3(k,num_conti,i)=gggm(k) &
4446 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4449 ! Diagnostics. Comment out or remove after debugging!
4451 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4452 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4453 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4454 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4455 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4456 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4459 endif ! num_conti.le.maxconts
4462 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4465 ghalf=0.5d0*agg(l,k)
4466 aggi(l,k)=aggi(l,k)+ghalf
4467 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4468 aggj(l,k)=aggj(l,k)+ghalf
4471 if (j.eq.nres-1 .and. i.lt.j-2) then
4474 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4480 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4482 end subroutine eelecij
4483 !-----------------------------------------------------------------------------
4484 subroutine eturn3(i,eello_turn3)
4485 ! Third- and fourth-order contributions from turns
4488 ! implicit real*8 (a-h,o-z)
4489 ! include 'DIMENSIONS'
4490 ! include 'COMMON.IOUNITS'
4491 ! include 'COMMON.GEO'
4492 ! include 'COMMON.VAR'
4493 ! include 'COMMON.LOCAL'
4494 ! include 'COMMON.CHAIN'
4495 ! include 'COMMON.DERIV'
4496 ! include 'COMMON.INTERACT'
4497 ! include 'COMMON.CONTACTS'
4498 ! include 'COMMON.TORSION'
4499 ! include 'COMMON.VECTORS'
4500 ! include 'COMMON.FFIELD'
4501 ! include 'COMMON.CONTROL'
4502 real(kind=8),dimension(3) :: ggg
4503 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4504 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4505 real(kind=8),dimension(2) :: auxvec,auxvec1
4506 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4507 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4508 !el integer :: num_conti,j1,j2
4509 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4510 !el dz_normi,xmedi,ymedi,zmedi
4512 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4513 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4516 integer :: i,j,l,k,ilist,iresshield
4517 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4520 ! write (iout,*) "eturn3",i,j,j1,j2
4521 zj=(c(3,j)+c(3,j+1))/2.0d0
4523 if (zj.lt.0) zj=zj+boxzsize
4524 if ((zj.lt.0)) write (*,*) "CHUJ"
4525 if ((zj.gt.bordlipbot) &
4526 .and.(zj.lt.bordliptop)) then
4527 !C the energy transfer exist
4528 if (zj.lt.buflipbot) then
4529 !C what fraction I am in
4531 ((zj-bordlipbot)/lipbufthick)
4532 !C lipbufthick is thickenes of lipid buffore
4533 sslipj=sscalelip(fracinbuf)
4534 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4535 elseif (zj.gt.bufliptop) then
4536 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4537 sslipj=sscalelip(fracinbuf)
4538 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4552 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4554 ! Third-order contributions
4561 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4562 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4563 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4564 call transpose2(auxmat(1,1),auxmat1(1,1))
4565 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4566 if (shield_mode.eq.0) then
4571 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4572 *fac_shield(i)*fac_shield(j) &
4573 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4575 0.5d0*(pizda(1,1)+pizda(2,2)) &
4576 *fac_shield(i)*fac_shield(j)
4578 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4579 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4580 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4581 (shield_mode.gt.0)) then
4584 do ilist=1,ishield_list(i)
4585 iresshield=shield_list(ilist,i)
4587 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4588 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4590 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4591 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4595 do ilist=1,ishield_list(j)
4596 iresshield=shield_list(ilist,j)
4598 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4599 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4601 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4602 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4609 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4610 grad_shield(k,i)*eello_t3/fac_shield(i)
4611 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4612 grad_shield(k,j)*eello_t3/fac_shield(j)
4613 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4614 grad_shield(k,i)*eello_t3/fac_shield(i)
4615 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4616 grad_shield(k,j)*eello_t3/fac_shield(j)
4620 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4621 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4622 !d & ' eello_turn3_num',4*eello_turn3_num
4623 ! Derivatives in gamma(i)
4624 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4625 call transpose2(auxmat2(1,1),auxmat3(1,1))
4626 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4627 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4628 *fac_shield(i)*fac_shield(j) &
4629 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4630 ! Derivatives in gamma(i+1)
4631 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4632 call transpose2(auxmat2(1,1),auxmat3(1,1))
4633 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4634 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4635 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4636 *fac_shield(i)*fac_shield(j) &
4637 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4639 ! Cartesian derivatives
4641 ! ghalf1=0.5d0*agg(l,1)
4642 ! ghalf2=0.5d0*agg(l,2)
4643 ! ghalf3=0.5d0*agg(l,3)
4644 ! ghalf4=0.5d0*agg(l,4)
4645 a_temp(1,1)=aggi(l,1)!+ghalf1
4646 a_temp(1,2)=aggi(l,2)!+ghalf2
4647 a_temp(2,1)=aggi(l,3)!+ghalf3
4648 a_temp(2,2)=aggi(l,4)!+ghalf4
4649 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4650 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4651 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4652 *fac_shield(i)*fac_shield(j) &
4653 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4655 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4656 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4657 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4658 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4659 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4660 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4661 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4662 *fac_shield(i)*fac_shield(j) &
4663 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4665 a_temp(1,1)=aggj(l,1)!+ghalf1
4666 a_temp(1,2)=aggj(l,2)!+ghalf2
4667 a_temp(2,1)=aggj(l,3)!+ghalf3
4668 a_temp(2,2)=aggj(l,4)!+ghalf4
4669 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4670 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4671 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4672 *fac_shield(i)*fac_shield(j) &
4673 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4675 a_temp(1,1)=aggj1(l,1)
4676 a_temp(1,2)=aggj1(l,2)
4677 a_temp(2,1)=aggj1(l,3)
4678 a_temp(2,2)=aggj1(l,4)
4679 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4680 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4681 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4682 *fac_shield(i)*fac_shield(j) &
4683 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4685 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4686 ssgradlipi*eello_t3/4.0d0*lipscale
4687 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4688 ssgradlipj*eello_t3/4.0d0*lipscale
4689 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4690 ssgradlipi*eello_t3/4.0d0*lipscale
4691 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4692 ssgradlipj*eello_t3/4.0d0*lipscale
4695 end subroutine eturn3
4696 !-----------------------------------------------------------------------------
4697 subroutine eturn4(i,eello_turn4)
4698 ! Third- and fourth-order contributions from turns
4701 ! implicit real*8 (a-h,o-z)
4702 ! include 'DIMENSIONS'
4703 ! include 'COMMON.IOUNITS'
4704 ! include 'COMMON.GEO'
4705 ! include 'COMMON.VAR'
4706 ! include 'COMMON.LOCAL'
4707 ! include 'COMMON.CHAIN'
4708 ! include 'COMMON.DERIV'
4709 ! include 'COMMON.INTERACT'
4710 ! include 'COMMON.CONTACTS'
4711 ! include 'COMMON.TORSION'
4712 ! include 'COMMON.VECTORS'
4713 ! include 'COMMON.FFIELD'
4714 ! include 'COMMON.CONTROL'
4715 real(kind=8),dimension(3) :: ggg
4716 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4717 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4718 real(kind=8),dimension(2) :: auxvec,auxvec1
4719 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4720 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4721 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4722 !el dz_normi,xmedi,ymedi,zmedi
4723 !el integer :: num_conti,j1,j2
4724 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4725 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4728 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4729 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4733 ! if (j.ne.20) return
4734 ! print *,i,j,gshieldc_t4(2,j),gshieldc_t4(2,j+1)
4735 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4737 ! Fourth-order contributions
4745 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4746 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4747 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4748 zj=(c(3,j)+c(3,j+1))/2.0d0
4750 if (zj.lt.0) zj=zj+boxzsize
4751 if ((zj.gt.bordlipbot) &
4752 .and.(zj.lt.bordliptop)) then
4753 !C the energy transfer exist
4754 if (zj.lt.buflipbot) then
4755 !C what fraction I am in
4757 ((zj-bordlipbot)/lipbufthick)
4758 !C lipbufthick is thickenes of lipid buffore
4759 sslipj=sscalelip(fracinbuf)
4760 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4761 elseif (zj.gt.bufliptop) then
4762 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4763 sslipj=sscalelip(fracinbuf)
4764 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4778 iti1=itortyp(itype(i+1,1))
4779 iti2=itortyp(itype(i+2,1))
4780 iti3=itortyp(itype(i+3,1))
4781 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4782 call transpose2(EUg(1,1,i+1),e1t(1,1))
4783 call transpose2(Eug(1,1,i+2),e2t(1,1))
4784 call transpose2(Eug(1,1,i+3),e3t(1,1))
4785 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4786 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4787 s1=scalar2(b1(1,iti2),auxvec(1))
4788 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4789 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4790 s2=scalar2(b1(1,iti1),auxvec(1))
4791 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4792 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4793 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4794 if (shield_mode.eq.0) then
4799 eello_turn4=eello_turn4-(s1+s2+s3) &
4800 *fac_shield(i)*fac_shield(j) &
4801 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4802 eello_t4=-(s1+s2+s3) &
4803 *fac_shield(i)*fac_shield(j)
4804 !C Now derivative over shield:
4805 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4806 (shield_mode.gt.0)) then
4809 do ilist=1,ishield_list(i)
4810 iresshield=shield_list(ilist,i)
4812 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4813 ! print *,"rlocshield",rlocshield,grad_shield_side(k,ilist,i),iresshield
4814 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4816 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4817 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4821 do ilist=1,ishield_list(j)
4822 iresshield=shield_list(ilist,j)
4824 ! print *,"rlocshieldj",j,rlocshield,grad_shield_side(k,ilist,j),iresshield
4825 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4826 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4828 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4829 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4831 ! print *,"after", gshieldc_t4(k,iresshield-1),iresshield-1,gshieldc_t4(k,iresshield)
4836 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
4837 grad_shield(k,i)*eello_t4/fac_shield(i)
4838 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
4839 grad_shield(k,j)*eello_t4/fac_shield(j)
4840 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
4841 grad_shield(k,i)*eello_t4/fac_shield(i)
4842 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
4843 grad_shield(k,j)*eello_t4/fac_shield(j)
4844 ! print *,"gshieldc_t4(k,j+1)",j,gshieldc_t4(k,j+1)
4848 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4849 'eturn4',i,j,-(s1+s2+s3)
4850 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4851 !d & ' eello_turn4_num',8*eello_turn4_num
4852 ! Derivatives in gamma(i)
4853 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4854 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4855 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4856 s1=scalar2(b1(1,iti2),auxvec(1))
4857 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4858 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4859 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
4860 *fac_shield(i)*fac_shield(j) &
4861 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4863 ! Derivatives in gamma(i+1)
4864 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4865 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4866 s2=scalar2(b1(1,iti1),auxvec(1))
4867 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4868 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4869 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4870 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
4871 *fac_shield(i)*fac_shield(j) &
4872 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4874 ! Derivatives in gamma(i+2)
4875 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4876 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4877 s1=scalar2(b1(1,iti2),auxvec(1))
4878 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4879 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4880 s2=scalar2(b1(1,iti1),auxvec(1))
4881 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4882 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4883 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4884 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
4885 *fac_shield(i)*fac_shield(j) &
4886 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4888 ! Cartesian derivatives
4889 ! Derivatives of this turn contributions in DC(i+2)
4890 if (j.lt.nres-1) then
4892 a_temp(1,1)=agg(l,1)
4893 a_temp(1,2)=agg(l,2)
4894 a_temp(2,1)=agg(l,3)
4895 a_temp(2,2)=agg(l,4)
4896 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4897 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4898 s1=scalar2(b1(1,iti2),auxvec(1))
4899 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4900 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4901 s2=scalar2(b1(1,iti1),auxvec(1))
4902 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4903 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4904 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4906 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
4907 *fac_shield(i)*fac_shield(j) &
4908 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4912 ! Remaining derivatives of this turn contribution
4914 a_temp(1,1)=aggi(l,1)
4915 a_temp(1,2)=aggi(l,2)
4916 a_temp(2,1)=aggi(l,3)
4917 a_temp(2,2)=aggi(l,4)
4918 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4919 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4920 s1=scalar2(b1(1,iti2),auxvec(1))
4921 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4922 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4923 s2=scalar2(b1(1,iti1),auxvec(1))
4924 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4925 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4926 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4927 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
4928 *fac_shield(i)*fac_shield(j) &
4929 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4932 a_temp(1,1)=aggi1(l,1)
4933 a_temp(1,2)=aggi1(l,2)
4934 a_temp(2,1)=aggi1(l,3)
4935 a_temp(2,2)=aggi1(l,4)
4936 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4937 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4938 s1=scalar2(b1(1,iti2),auxvec(1))
4939 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4940 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4941 s2=scalar2(b1(1,iti1),auxvec(1))
4942 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4943 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4944 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4945 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
4946 *fac_shield(i)*fac_shield(j) &
4947 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4950 a_temp(1,1)=aggj(l,1)
4951 a_temp(1,2)=aggj(l,2)
4952 a_temp(2,1)=aggj(l,3)
4953 a_temp(2,2)=aggj(l,4)
4954 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4955 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4956 s1=scalar2(b1(1,iti2),auxvec(1))
4957 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4958 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4959 s2=scalar2(b1(1,iti1),auxvec(1))
4960 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4961 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4962 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4963 ! if (j.lt.nres-1) then
4964 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
4965 *fac_shield(i)*fac_shield(j) &
4966 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4969 a_temp(1,1)=aggj1(l,1)
4970 a_temp(1,2)=aggj1(l,2)
4971 a_temp(2,1)=aggj1(l,3)
4972 a_temp(2,2)=aggj1(l,4)
4973 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4974 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4975 s1=scalar2(b1(1,iti2),auxvec(1))
4976 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4977 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4978 s2=scalar2(b1(1,iti1),auxvec(1))
4979 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4980 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4981 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4982 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4983 ! if (j.lt.nres-1) then
4984 ! print *,"juest before",j1, gcorr4_turn(l,j1)
4985 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
4986 *fac_shield(i)*fac_shield(j) &
4987 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4988 ! if (shield_mode.gt.0) then
4989 ! print *,"juest after",j1, gcorr4_turn(l,j1),gshieldc_t4(k,j1),gshieldc_loc_t4(k,j1),gel_loc_turn4(i+2)
4991 ! print *,"juest after",j1, gcorr4_turn(l,j1),gel_loc_turn4(i+2)
4995 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
4996 ssgradlipi*eello_t4/4.0d0*lipscale
4997 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
4998 ssgradlipj*eello_t4/4.0d0*lipscale
4999 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
5000 ssgradlipi*eello_t4/4.0d0*lipscale
5001 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
5002 ssgradlipj*eello_t4/4.0d0*lipscale
5005 end subroutine eturn4
5006 !-----------------------------------------------------------------------------
5007 subroutine unormderiv(u,ugrad,unorm,ungrad)
5008 ! This subroutine computes the derivatives of a normalized vector u, given
5009 ! the derivatives computed without normalization conditions, ugrad. Returns
5012 real(kind=8),dimension(3) :: u,vec
5013 real(kind=8),dimension(3,3) ::ugrad,ungrad
5014 real(kind=8) :: unorm !,scalar
5016 ! write (2,*) 'ugrad',ugrad
5019 vec(i)=scalar(ugrad(1,i),u(1))
5021 ! write (2,*) 'vec',vec
5024 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5027 ! write (2,*) 'ungrad',ungrad
5029 end subroutine unormderiv
5030 !-----------------------------------------------------------------------------
5031 subroutine escp_soft_sphere(evdw2,evdw2_14)
5033 ! This subroutine calculates the excluded-volume interaction energy between
5034 ! peptide-group centers and side chains and its gradient in virtual-bond and
5035 ! side-chain vectors.
5037 ! implicit real*8 (a-h,o-z)
5038 ! include 'DIMENSIONS'
5039 ! include 'COMMON.GEO'
5040 ! include 'COMMON.VAR'
5041 ! include 'COMMON.LOCAL'
5042 ! include 'COMMON.CHAIN'
5043 ! include 'COMMON.DERIV'
5044 ! include 'COMMON.INTERACT'
5045 ! include 'COMMON.FFIELD'
5046 ! include 'COMMON.IOUNITS'
5047 ! include 'COMMON.CONTROL'
5048 real(kind=8),dimension(3) :: ggg
5050 integer :: i,iint,j,k,iteli,itypj
5051 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
5052 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
5057 !d print '(a)','Enter ESCP'
5058 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5059 do i=iatscp_s,iatscp_e
5060 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
5062 xi=0.5D0*(c(1,i)+c(1,i+1))
5063 yi=0.5D0*(c(2,i)+c(2,i+1))
5064 zi=0.5D0*(c(3,i)+c(3,i+1))
5066 do iint=1,nscp_gr(i)
5068 do j=iscpstart(i,iint),iscpend(i,iint)
5069 if (itype(j,1).eq.ntyp1) cycle
5070 itypj=iabs(itype(j,1))
5071 ! Uncomment following three lines for SC-p interactions
5075 ! Uncomment following three lines for Ca-p interactions
5079 rij=xj*xj+yj*yj+zj*zj
5082 if (rij.lt.r0ijsq) then
5083 evdwij=0.25d0*(rij-r0ijsq)**2
5091 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5096 !grad if (j.lt.i) then
5097 !d write (iout,*) 'j<i'
5098 ! Uncomment following three lines for SC-p interactions
5100 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5103 !d write (iout,*) 'j>i'
5105 !grad ggg(k)=-ggg(k)
5106 ! Uncomment following line for SC-p interactions
5107 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5111 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5113 !grad kstart=min0(i+1,j)
5114 !grad kend=max0(i-1,j-1)
5115 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5116 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5117 !grad do k=kstart,kend
5119 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5123 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5124 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5131 end subroutine escp_soft_sphere
5132 !-----------------------------------------------------------------------------
5133 subroutine escp(evdw2,evdw2_14)
5135 ! This subroutine calculates the excluded-volume interaction energy between
5136 ! peptide-group centers and side chains and its gradient in virtual-bond and
5137 ! side-chain vectors.
5139 ! implicit real*8 (a-h,o-z)
5140 ! include 'DIMENSIONS'
5141 ! include 'COMMON.GEO'
5142 ! include 'COMMON.VAR'
5143 ! include 'COMMON.LOCAL'
5144 ! include 'COMMON.CHAIN'
5145 ! include 'COMMON.DERIV'
5146 ! include 'COMMON.INTERACT'
5147 ! include 'COMMON.FFIELD'
5148 ! include 'COMMON.IOUNITS'
5149 ! include 'COMMON.CONTROL'
5150 real(kind=8),dimension(3) :: ggg
5152 integer :: i,iint,j,k,iteli,itypj,subchap
5153 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
5155 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
5156 dist_temp, dist_init
5157 integer xshift,yshift,zshift
5161 !d print '(a)','Enter ESCP'
5162 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5163 do i=iatscp_s,iatscp_e
5164 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
5166 xi=0.5D0*(c(1,i)+c(1,i+1))
5167 yi=0.5D0*(c(2,i)+c(2,i+1))
5168 zi=0.5D0*(c(3,i)+c(3,i+1))
5170 if (xi.lt.0) xi=xi+boxxsize
5172 if (yi.lt.0) yi=yi+boxysize
5174 if (zi.lt.0) zi=zi+boxzsize
5176 do iint=1,nscp_gr(i)
5178 do j=iscpstart(i,iint),iscpend(i,iint)
5179 itypj=iabs(itype(j,1))
5180 if (itypj.eq.ntyp1) cycle
5181 ! Uncomment following three lines for SC-p interactions
5185 ! Uncomment following three lines for Ca-p interactions
5193 if (xj.lt.0) xj=xj+boxxsize
5195 if (yj.lt.0) yj=yj+boxysize
5197 if (zj.lt.0) zj=zj+boxzsize
5198 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5206 xj=xj_safe+xshift*boxxsize
5207 yj=yj_safe+yshift*boxysize
5208 zj=zj_safe+zshift*boxzsize
5209 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5210 if(dist_temp.lt.dist_init) then
5220 if (subchap.eq.1) then
5230 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5231 rij=dsqrt(1.0d0/rrij)
5232 sss_ele_cut=sscale_ele(rij)
5233 sss_ele_grad=sscagrad_ele(rij)
5234 ! print *,sss_ele_cut,sss_ele_grad,&
5235 ! (rij),r_cut_ele,rlamb_ele
5236 if (sss_ele_cut.le.0.0) cycle
5238 e1=fac*fac*aad(itypj,iteli)
5239 e2=fac*bad(itypj,iteli)
5240 if (iabs(j-i) .le. 2) then
5243 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
5246 evdw2=evdw2+evdwij*sss_ele_cut
5247 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
5248 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
5249 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5252 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5254 fac=-(evdwij+e1)*rrij*sss_ele_cut
5255 fac=fac+evdwij*sss_ele_grad/rij/expon
5259 !grad if (j.lt.i) then
5260 !d write (iout,*) 'j<i'
5261 ! Uncomment following three lines for SC-p interactions
5263 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5266 !d write (iout,*) 'j>i'
5268 !grad ggg(k)=-ggg(k)
5269 ! Uncomment following line for SC-p interactions
5270 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5271 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5275 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5277 !grad kstart=min0(i+1,j)
5278 !grad kend=max0(i-1,j-1)
5279 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5280 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5281 !grad do k=kstart,kend
5283 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5287 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5288 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5296 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5297 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5298 gradx_scp(j,i)=expon*gradx_scp(j,i)
5301 !******************************************************************************
5305 ! To save time the factor EXPON has been extracted from ALL components
5306 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
5309 !******************************************************************************
5312 !-----------------------------------------------------------------------------
5313 subroutine edis(ehpb)
5315 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5317 ! implicit real*8 (a-h,o-z)
5318 ! include 'DIMENSIONS'
5319 ! include 'COMMON.SBRIDGE'
5320 ! include 'COMMON.CHAIN'
5321 ! include 'COMMON.DERIV'
5322 ! include 'COMMON.VAR'
5323 ! include 'COMMON.INTERACT'
5324 ! include 'COMMON.IOUNITS'
5325 real(kind=8),dimension(3) :: ggg
5327 integer :: i,j,ii,jj,iii,jjj,k
5328 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
5331 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5332 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
5333 if (link_end.eq.0) return
5334 do i=link_start,link_end
5335 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5336 ! CA-CA distance used in regularization of structure.
5339 ! iii and jjj point to the residues for which the distance is assigned.
5340 if (ii.gt.nres) then
5347 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5348 ! & dhpb(i),dhpb1(i),forcon(i)
5349 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
5350 ! distance and angle dependent SS bond potential.
5351 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5352 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5353 if (.not.dyn_ss .and. i.le.nss) then
5354 ! 15/02/13 CC dynamic SSbond - additional check
5355 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
5356 iabs(itype(jjj,1)).eq.1) then
5357 call ssbond_ene(iii,jjj,eij)
5359 !d write (iout,*) "eij",eij
5361 else if (ii.gt.nres .and. jj.gt.nres) then
5362 !c Restraints from contact prediction
5364 if (constr_dist.eq.11) then
5365 ehpb=ehpb+fordepth(i)**4.0d0 &
5366 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5367 fac=fordepth(i)**4.0d0 &
5368 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5369 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5372 if (dhpb1(i).gt.0.0d0) then
5373 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5374 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5375 !c write (iout,*) "beta nmr",
5376 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5380 !C Get the force constant corresponding to this distance.
5382 !C Calculate the contribution to energy.
5383 ehpb=ehpb+waga*rdis*rdis
5384 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
5386 !C Evaluate gradient.
5392 ggg(j)=fac*(c(j,jj)-c(j,ii))
5395 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5396 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5399 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5400 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5404 if (constr_dist.eq.11) then
5405 ehpb=ehpb+fordepth(i)**4.0d0 &
5406 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5407 fac=fordepth(i)**4.0d0 &
5408 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5409 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5412 if (dhpb1(i).gt.0.0d0) then
5413 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5414 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5415 !c write (iout,*) "alph nmr",
5416 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5419 !C Get the force constant corresponding to this distance.
5421 !C Calculate the contribution to energy.
5422 ehpb=ehpb+waga*rdis*rdis
5423 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5425 !C Evaluate gradient.
5432 ggg(j)=fac*(c(j,jj)-c(j,ii))
5434 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5435 !C If this is a SC-SC distance, we need to calculate the contributions to the
5436 !C Cartesian gradient in the SC vectors (ghpbx).
5439 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5440 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5443 !cgrad do j=iii,jjj-1
5445 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5449 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5450 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5454 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5458 !-----------------------------------------------------------------------------
5459 subroutine ssbond_ene(i,j,eij)
5461 ! Calculate the distance and angle dependent SS-bond potential energy
5462 ! using a free-energy function derived based on RHF/6-31G** ab initio
5463 ! calculations of diethyl disulfide.
5465 ! A. Liwo and U. Kozlowska, 11/24/03
5467 ! implicit real*8 (a-h,o-z)
5468 ! include 'DIMENSIONS'
5469 ! include 'COMMON.SBRIDGE'
5470 ! include 'COMMON.CHAIN'
5471 ! include 'COMMON.DERIV'
5472 ! include 'COMMON.LOCAL'
5473 ! include 'COMMON.INTERACT'
5474 ! include 'COMMON.VAR'
5475 ! include 'COMMON.IOUNITS'
5476 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5478 integer :: i,j,itypi,itypj,k
5479 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5480 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5481 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5484 itypi=iabs(itype(i,1))
5488 dxi=dc_norm(1,nres+i)
5489 dyi=dc_norm(2,nres+i)
5490 dzi=dc_norm(3,nres+i)
5491 ! dsci_inv=dsc_inv(itypi)
5492 dsci_inv=vbld_inv(nres+i)
5493 itypj=iabs(itype(j,1))
5494 ! dscj_inv=dsc_inv(itypj)
5495 dscj_inv=vbld_inv(nres+j)
5499 dxj=dc_norm(1,nres+j)
5500 dyj=dc_norm(2,nres+j)
5501 dzj=dc_norm(3,nres+j)
5502 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5507 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5508 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5509 om12=dxi*dxj+dyi*dyj+dzi*dzj
5511 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5512 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5518 deltat12=om2-om1+2.0d0
5520 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5521 +akct*deltad*deltat12 &
5522 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5523 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5524 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5525 ! & " deltat12",deltat12," eij",eij
5526 ed=2*akcm*deltad+akct*deltat12
5528 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5529 eom1=-2*akth*deltat1-pom1-om2*pom2
5530 eom2= 2*akth*deltat2+pom1-om1*pom2
5533 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5534 ghpbx(k,i)=ghpbx(k,i)-ggk &
5535 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5536 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5537 ghpbx(k,j)=ghpbx(k,j)+ggk &
5538 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5539 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5540 ghpbc(k,i)=ghpbc(k,i)-ggk
5541 ghpbc(k,j)=ghpbc(k,j)+ggk
5544 ! Calculate the components of the gradient in DC and X
5548 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5552 end subroutine ssbond_ene
5553 !-----------------------------------------------------------------------------
5554 subroutine ebond(estr)
5556 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5558 ! implicit real*8 (a-h,o-z)
5559 ! include 'DIMENSIONS'
5560 ! include 'COMMON.LOCAL'
5561 ! include 'COMMON.GEO'
5562 ! include 'COMMON.INTERACT'
5563 ! include 'COMMON.DERIV'
5564 ! include 'COMMON.VAR'
5565 ! include 'COMMON.CHAIN'
5566 ! include 'COMMON.IOUNITS'
5567 ! include 'COMMON.NAMES'
5568 ! include 'COMMON.FFIELD'
5569 ! include 'COMMON.CONTROL'
5570 ! include 'COMMON.SETUP'
5571 real(kind=8),dimension(3) :: u,ud
5573 integer :: i,j,iti,nbi,k
5574 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5579 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5580 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5582 do i=ibondp_start,ibondp_end
5583 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5584 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5585 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5587 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5588 !C *dc(j,i-1)/vbld(i)
5590 !C if (energy_dec) write(iout,*) &
5591 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5592 diff = vbld(i)-vbldpDUM
5594 diff = vbld(i)-vbldp0
5596 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5597 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5600 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5602 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5605 estr=0.5d0*AKP*estr+estr1
5606 ! print *,"estr_bb",estr,AKP
5608 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5610 do i=ibond_start,ibond_end
5611 iti=iabs(itype(i,1))
5612 if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
5613 if (iti.ne.10 .and. iti.ne.ntyp1) then
5616 diff=vbld(i+nres)-vbldsc0(1,iti)
5617 if (energy_dec) write (iout,*) &
5618 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5619 AKSC(1,iti),AKSC(1,iti)*diff*diff
5620 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5621 ! print *,"estr_sc",estr
5623 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5627 diff=vbld(i+nres)-vbldsc0(j,iti)
5628 ud(j)=aksc(j,iti)*diff
5629 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5643 uprod2=uprod2*u(k)*u(k)
5647 usumsqder=usumsqder+ud(j)*uprod2
5649 estr=estr+uprod/usum
5650 ! print *,"estr_sc",estr,i
5652 if (energy_dec) write (iout,*) &
5653 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5654 AKSC(1,iti),uprod/usum
5656 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5662 end subroutine ebond
5664 !-----------------------------------------------------------------------------
5665 subroutine ebend(etheta)
5667 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5668 ! angles gamma and its derivatives in consecutive thetas and gammas.
5671 ! implicit real*8 (a-h,o-z)
5672 ! include 'DIMENSIONS'
5673 ! include 'COMMON.LOCAL'
5674 ! include 'COMMON.GEO'
5675 ! include 'COMMON.INTERACT'
5676 ! include 'COMMON.DERIV'
5677 ! include 'COMMON.VAR'
5678 ! include 'COMMON.CHAIN'
5679 ! include 'COMMON.IOUNITS'
5680 ! include 'COMMON.NAMES'
5681 ! include 'COMMON.FFIELD'
5682 ! include 'COMMON.CONTROL'
5683 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5684 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5685 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5687 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5688 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5689 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5691 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5693 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5694 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5695 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5696 real(kind=8),dimension(2) :: y,z
5699 ! time11=dexp(-2*time)
5702 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5703 do i=ithet_start,ithet_end
5704 if (itype(i-1,1).eq.ntyp1) cycle
5705 ! Zero the energy function and its derivative at 0 or pi.
5706 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5708 ichir1=isign(1,itype(i-2,1))
5709 ichir2=isign(1,itype(i,1))
5710 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
5711 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
5712 if (itype(i-1,1).eq.10) then
5713 itype1=isign(10,itype(i-2,1))
5714 ichir11=isign(1,itype(i-2,1))
5715 ichir12=isign(1,itype(i-2,1))
5716 itype2=isign(10,itype(i,1))
5717 ichir21=isign(1,itype(i,1))
5718 ichir22=isign(1,itype(i,1))
5721 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
5724 if (phii.ne.phii) phii=150.0
5734 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
5737 if (phii1.ne.phii1) phii1=150.0
5749 ! Calculate the "mean" value of theta from the part of the distribution
5750 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5751 ! In following comments this theta will be referred to as t_c.
5752 thet_pred_mean=0.0d0
5754 athetk=athet(k,it,ichir1,ichir2)
5755 bthetk=bthet(k,it,ichir1,ichir2)
5757 athetk=athet(k,itype1,ichir11,ichir12)
5758 bthetk=bthet(k,itype2,ichir21,ichir22)
5760 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5762 dthett=thet_pred_mean*ssd
5763 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5764 ! Derivatives of the "mean" values in gamma1 and gamma2.
5765 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5766 +athet(2,it,ichir1,ichir2)*y(1))*ss
5767 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5768 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5770 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5771 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5772 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5773 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5775 if (theta(i).gt.pi-delta) then
5776 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5778 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5779 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5780 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5782 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5784 else if (theta(i).lt.delta) then
5785 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5786 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5787 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5789 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5790 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5793 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5796 etheta=etheta+ethetai
5797 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5799 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5800 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5801 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5803 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5805 ! Ufff.... We've done all this!!!
5807 end subroutine ebend
5808 !-----------------------------------------------------------------------------
5809 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5812 ! implicit real*8 (a-h,o-z)
5813 ! include 'DIMENSIONS'
5814 ! include 'COMMON.LOCAL'
5815 ! include 'COMMON.IOUNITS'
5816 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5817 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5818 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5820 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5822 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5823 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5824 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5826 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5827 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5829 ! Calculate the contributions to both Gaussian lobes.
5830 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5831 ! The "polynomial part" of the "standard deviation" of this part of
5835 sig=sig*thet_pred_mean+polthet(j,it)
5837 ! Derivative of the "interior part" of the "standard deviation of the"
5838 ! gamma-dependent Gaussian lobe in t_c.
5839 sigtc=3*polthet(3,it)
5841 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5844 ! Set the parameters of both Gaussian lobes of the distribution.
5845 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5846 fac=sig*sig+sigc0(it)
5849 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5850 sigsqtc=-4.0D0*sigcsq*sigtc
5851 ! print *,i,sig,sigtc,sigsqtc
5852 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5853 sigtc=-sigtc/(fac*fac)
5854 ! Following variable is sigma(t_c)**(-2)
5855 sigcsq=sigcsq*sigcsq
5857 sig0inv=1.0D0/sig0i**2
5858 delthec=thetai-thet_pred_mean
5859 delthe0=thetai-theta0i
5860 term1=-0.5D0*sigcsq*delthec*delthec
5861 term2=-0.5D0*sig0inv*delthe0*delthe0
5862 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5863 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5864 ! to the energy (this being the log of the distribution) at the end of energy
5865 ! term evaluation for this virtual-bond angle.
5866 if (term1.gt.term2) then
5868 term2=dexp(term2-termm)
5872 term1=dexp(term1-termm)
5875 ! The ratio between the gamma-independent and gamma-dependent lobes of
5876 ! the distribution is a Gaussian function of thet_pred_mean too.
5877 diffak=gthet(2,it)-thet_pred_mean
5878 ratak=diffak/gthet(3,it)**2
5879 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5880 ! Let's differentiate it in thet_pred_mean NOW.
5882 ! Now put together the distribution terms to make complete distribution.
5883 termexp=term1+ak*term2
5884 termpre=sigc+ak*sig0i
5885 ! Contribution of the bending energy from this theta is just the -log of
5886 ! the sum of the contributions from the two lobes and the pre-exponential
5887 ! factor. Simple enough, isn't it?
5888 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5889 ! NOW the derivatives!!!
5890 ! 6/6/97 Take into account the deformation.
5891 E_theta=(delthec*sigcsq*term1 &
5892 +ak*delthe0*sig0inv*term2)/termexp
5893 E_tc=((sigtc+aktc*sig0i)/termpre &
5894 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5895 aktc*term2)/termexp)
5897 end subroutine theteng
5899 !-----------------------------------------------------------------------------
5900 subroutine ebend(etheta,ethetacnstr)
5902 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5903 ! angles gamma and its derivatives in consecutive thetas and gammas.
5904 ! ab initio-derived potentials from
5905 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5907 ! implicit real*8 (a-h,o-z)
5908 ! include 'DIMENSIONS'
5909 ! include 'COMMON.LOCAL'
5910 ! include 'COMMON.GEO'
5911 ! include 'COMMON.INTERACT'
5912 ! include 'COMMON.DERIV'
5913 ! include 'COMMON.VAR'
5914 ! include 'COMMON.CHAIN'
5915 ! include 'COMMON.IOUNITS'
5916 ! include 'COMMON.NAMES'
5917 ! include 'COMMON.FFIELD'
5918 ! include 'COMMON.CONTROL'
5919 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5920 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5921 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5922 logical :: lprn=.false., lprn1=.false.
5924 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5925 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5926 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
5927 ! local variables for constrains
5928 real(kind=8) :: difi,thetiii
5930 ! write(iout,*) "in ebend",ithet_start,ithet_end
5933 do i=ithet_start,ithet_end
5934 if (itype(i-1,1).eq.ntyp1) cycle
5935 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
5936 if (iabs(itype(i+1,1)).eq.20) iblock=2
5937 if (iabs(itype(i+1,1)).ne.20) iblock=1
5941 theti2=0.5d0*theta(i)
5942 ityp2=ithetyp((itype(i-1,1)))
5944 coskt(k)=dcos(k*theti2)
5945 sinkt(k)=dsin(k*theti2)
5947 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
5950 if (phii.ne.phii) phii=150.0
5954 ityp1=ithetyp((itype(i-2,1)))
5955 ! propagation of chirality for glycine type
5957 cosph1(k)=dcos(k*phii)
5958 sinph1(k)=dsin(k*phii)
5962 ityp1=ithetyp(itype(i-2,1))
5968 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
5971 if (phii1.ne.phii1) phii1=150.0
5976 ityp3=ithetyp((itype(i,1)))
5978 cosph2(k)=dcos(k*phii1)
5979 sinph2(k)=dsin(k*phii1)
5983 ityp3=ithetyp(itype(i,1))
5989 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5992 ccl=cosph1(l)*cosph2(k-l)
5993 ssl=sinph1(l)*sinph2(k-l)
5994 scl=sinph1(l)*cosph2(k-l)
5995 csl=cosph1(l)*sinph2(k-l)
5996 cosph1ph2(l,k)=ccl-ssl
5997 cosph1ph2(k,l)=ccl+ssl
5998 sinph1ph2(l,k)=scl+csl
5999 sinph1ph2(k,l)=scl-csl
6003 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
6004 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6005 write (iout,*) "coskt and sinkt"
6007 write (iout,*) k,coskt(k),sinkt(k)
6011 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6012 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
6015 write (iout,*) "k",k,&
6016 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
6020 write (iout,*) "cosph and sinph"
6022 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6024 write (iout,*) "cosph1ph2 and sinph2ph2"
6027 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
6028 sinph1ph2(l,k),sinph1ph2(k,l)
6031 write(iout,*) "ethetai",ethetai
6035 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
6036 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
6037 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
6038 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6039 ethetai=ethetai+sinkt(m)*aux
6040 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6041 dephii=dephii+k*sinkt(m)* &
6042 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
6043 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6044 dephii1=dephii1+k*sinkt(m)* &
6045 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
6046 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6048 write (iout,*) "m",m," k",k," bbthet", &
6049 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
6050 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
6051 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
6052 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6056 write(iout,*) "ethetai",ethetai
6060 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
6061 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
6062 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
6063 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6064 ethetai=ethetai+sinkt(m)*aux
6065 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6066 dephii=dephii+l*sinkt(m)* &
6067 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
6068 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
6069 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
6070 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6071 dephii1=dephii1+(k-l)*sinkt(m)* &
6072 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
6073 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
6074 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
6075 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6077 write (iout,*) "m",m," k",k," l",l," ffthet",&
6078 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
6079 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
6080 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
6081 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
6083 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
6084 cosph1ph2(k,l)*sinkt(m),&
6085 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6093 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
6094 i,theta(i)*rad2deg,phii*rad2deg,&
6095 phii1*rad2deg,ethetai
6097 etheta=etheta+ethetai
6098 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6100 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6101 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6102 gloc(nphi+i-2,icg)=wang*dethetai
6104 !-----------thete constrains
6105 ! if (tor_mode.ne.2) then
6107 print *,ithetaconstr_start,ithetaconstr_end,"TU"
6108 do i=ithetaconstr_start,ithetaconstr_end
6109 itheta=itheta_constr(i)
6110 thetiii=theta(itheta)
6111 difi=pinorm(thetiii-theta_constr0(i))
6112 if (difi.gt.theta_drange(i)) then
6113 difi=difi-theta_drange(i)
6114 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6115 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
6116 +for_thet_constr(i)*difi**3
6117 else if (difi.lt.-drange(i)) then
6119 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6120 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
6121 +for_thet_constr(i)*difi**3
6125 if (energy_dec) then
6126 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", &
6127 i,itheta,rad2deg*thetiii, &
6128 rad2deg*theta_constr0(i), rad2deg*theta_drange(i), &
6129 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, &
6130 gloc(itheta+nphi-2,icg)
6136 end subroutine ebend
6139 !-----------------------------------------------------------------------------
6140 subroutine esc(escloc)
6141 ! Calculate the local energy of a side chain and its derivatives in the
6142 ! corresponding virtual-bond valence angles THETA and the spherical angles
6146 ! implicit real*8 (a-h,o-z)
6147 ! include 'DIMENSIONS'
6148 ! include 'COMMON.GEO'
6149 ! include 'COMMON.LOCAL'
6150 ! include 'COMMON.VAR'
6151 ! include 'COMMON.INTERACT'
6152 ! include 'COMMON.DERIV'
6153 ! include 'COMMON.CHAIN'
6154 ! include 'COMMON.IOUNITS'
6155 ! include 'COMMON.NAMES'
6156 ! include 'COMMON.FFIELD'
6157 ! include 'COMMON.CONTROL'
6158 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
6159 ddersc0,ddummy,xtemp,temp
6160 !el real(kind=8) :: time11,time12,time112,theti
6161 real(kind=8) :: escloc,delta
6162 !el integer :: it,nlobit
6163 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6166 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
6167 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
6170 ! write (iout,'(a)') 'ESC'
6171 do i=loc_start,loc_end
6173 if (it.eq.ntyp1) cycle
6174 if (it.eq.10) goto 1
6175 nlobit=nlob(iabs(it))
6176 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
6177 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6178 theti=theta(i+1)-pipol
6183 if (x(2).gt.pi-delta) then
6187 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6189 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6190 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
6192 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
6193 ddersc0(1),dersc(1))
6194 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
6195 ddersc0(3),dersc(3))
6197 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6199 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6200 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
6201 dersc0(2),esclocbi,dersc02)
6202 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
6204 call splinthet(x(2),0.5d0*delta,ss,ssd)
6209 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6211 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6212 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6214 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6216 ! write (iout,*) escloci
6217 else if (x(2).lt.delta) then
6221 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6223 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6224 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
6226 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6227 ddersc0(1),dersc(1))
6228 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
6229 ddersc0(3),dersc(3))
6231 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6233 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6234 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
6235 dersc0(2),esclocbi,dersc02)
6236 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6241 call splinthet(x(2),0.5d0*delta,ss,ssd)
6243 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6245 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6246 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6248 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6249 ! write (iout,*) escloci
6251 call enesc(x,escloci,dersc,ddummy,.false.)
6254 escloc=escloc+escloci
6255 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6257 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6259 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
6261 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6262 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6267 !-----------------------------------------------------------------------------
6268 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6271 ! implicit real*8 (a-h,o-z)
6272 ! include 'DIMENSIONS'
6273 ! include 'COMMON.GEO'
6274 ! include 'COMMON.LOCAL'
6275 ! include 'COMMON.IOUNITS'
6276 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6277 real(kind=8),dimension(3) :: x,z,dersc,ddersc
6278 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
6279 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
6280 real(kind=8) :: escloci
6283 integer :: j,iii,l,k !el,it,nlobit
6284 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
6285 !el time11,time12,time112
6286 ! write (iout,*) 'it=',it,' nlobit=',nlobit
6290 if (mixed) ddersc(j)=0.0d0
6294 ! Because of periodicity of the dependence of the SC energy in omega we have
6295 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6296 ! To avoid underflows, first compute & store the exponents.
6304 z(k)=x(k)-censc(k,j,it)
6309 Axk=Axk+gaussc(l,k,j,it)*z(l)
6315 expfac=expfac+Ax(k,j,iii)*z(k)
6323 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6324 ! subsequent NaNs and INFs in energy calculation.
6325 ! Find the largest exponent
6329 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6333 !d print *,'it=',it,' emin=',emin
6335 ! Compute the contribution to SC energy and derivatives
6340 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6341 if(adexp.ne.adexp) adexp=1.0
6344 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6346 !d print *,'j=',j,' expfac=',expfac
6347 escloc_i=escloc_i+expfac
6349 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6353 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
6354 +gaussc(k,2,j,it))*expfac
6361 dersc(1)=dersc(1)/cos(theti)**2
6362 ddersc(1)=ddersc(1)/cos(theti)**2
6365 escloci=-(dlog(escloc_i)-emin)
6367 dersc(j)=dersc(j)/escloc_i
6371 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6375 end subroutine enesc
6376 !-----------------------------------------------------------------------------
6377 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6380 ! implicit real*8 (a-h,o-z)
6381 ! include 'DIMENSIONS'
6382 ! include 'COMMON.GEO'
6383 ! include 'COMMON.LOCAL'
6384 ! include 'COMMON.IOUNITS'
6385 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6386 real(kind=8),dimension(3) :: x,z,dersc
6387 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
6388 real(kind=8),dimension(nlobit) :: contr !(maxlob)
6389 real(kind=8) :: escloci,dersc12,emin
6392 integer :: j,k,l !el,it,nlobit
6393 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
6403 z(k)=x(k)-censc(k,j,it)
6409 Axk=Axk+gaussc(l,k,j,it)*z(l)
6415 expfac=expfac+Ax(k,j)*z(k)
6420 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6421 ! subsequent NaNs and INFs in energy calculation.
6422 ! Find the largest exponent
6425 if (emin.gt.contr(j)) emin=contr(j)
6429 ! Compute the contribution to SC energy and derivatives
6433 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6434 escloc_i=escloc_i+expfac
6436 dersc(k)=dersc(k)+Ax(k,j)*expfac
6438 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
6439 +gaussc(1,2,j,it))*expfac
6443 dersc(1)=dersc(1)/cos(theti)**2
6444 dersc12=dersc12/cos(theti)**2
6445 escloci=-(dlog(escloc_i)-emin)
6447 dersc(j)=dersc(j)/escloc_i
6449 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6451 end subroutine enesc_bound
6453 !-----------------------------------------------------------------------------
6454 subroutine esc(escloc)
6455 ! Calculate the local energy of a side chain and its derivatives in the
6456 ! corresponding virtual-bond valence angles THETA and the spherical angles
6457 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
6458 ! added by Urszula Kozlowska. 07/11/2007
6461 ! implicit real*8 (a-h,o-z)
6462 ! include 'DIMENSIONS'
6463 ! include 'COMMON.GEO'
6464 ! include 'COMMON.LOCAL'
6465 ! include 'COMMON.VAR'
6466 ! include 'COMMON.SCROT'
6467 ! include 'COMMON.INTERACT'
6468 ! include 'COMMON.DERIV'
6469 ! include 'COMMON.CHAIN'
6470 ! include 'COMMON.IOUNITS'
6471 ! include 'COMMON.NAMES'
6472 ! include 'COMMON.FFIELD'
6473 ! include 'COMMON.CONTROL'
6474 ! include 'COMMON.VECTORS'
6475 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6476 real(kind=8),dimension(65) :: x
6477 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6478 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6479 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6480 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6481 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6483 integer :: i,j,k !el,it,nlobit
6484 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6485 !el real(kind=8) :: time11,time12,time112,theti
6486 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6487 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6488 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6489 sumene1x,sumene2x,sumene3x,sumene4x,&
6490 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6493 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6494 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6497 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6501 do i=loc_start,loc_end
6502 if (itype(i,1).eq.ntyp1) cycle
6503 costtab(i+1) =dcos(theta(i+1))
6504 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6505 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6506 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6507 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6508 cosfac=dsqrt(cosfac2)
6509 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6510 sinfac=dsqrt(sinfac2)
6512 if (it.eq.10) goto 1
6514 ! Compute the axes of tghe local cartesian coordinates system; store in
6515 ! x_prime, y_prime and z_prime
6522 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6523 ! & dc_norm(3,i+nres)
6525 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6526 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6529 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6532 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6533 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6534 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6535 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6536 ! & " xy",scalar(x_prime(1),y_prime(1)),
6537 ! & " xz",scalar(x_prime(1),z_prime(1)),
6538 ! & " yy",scalar(y_prime(1),y_prime(1)),
6539 ! & " yz",scalar(y_prime(1),z_prime(1)),
6540 ! & " zz",scalar(z_prime(1),z_prime(1))
6542 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6543 ! to local coordinate system. Store in xx, yy, zz.
6549 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6550 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6551 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6558 ! Compute the energy of the ith side cbain
6560 ! write (2,*) "xx",xx," yy",yy," zz",zz
6563 x(j) = sc_parmin(j,it)
6566 !c diagnostics - remove later
6568 yy1 = dsin(alph(2))*dcos(omeg(2))
6569 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6570 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6571 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6573 !," --- ", xx_w,yy_w,zz_w
6576 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6577 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6579 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6580 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6582 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6583 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6584 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6585 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6586 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6588 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6589 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6590 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6591 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6592 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6594 dsc_i = 0.743d0+x(61)
6596 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6597 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6598 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6599 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6600 s1=(1+x(63))/(0.1d0 + dscp1)
6601 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6602 s2=(1+x(65))/(0.1d0 + dscp2)
6603 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6604 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6605 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6606 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6608 ! & dscp1,dscp2,sumene
6609 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6610 escloc = escloc + sumene
6611 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6616 ! This section to check the numerical derivatives of the energy of ith side
6617 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6618 ! #define DEBUG in the code to turn it on.
6620 write (2,*) "sumene =",sumene
6624 write (2,*) xx,yy,zz
6625 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6626 de_dxx_num=(sumenep-sumene)/aincr
6628 write (2,*) "xx+ sumene from enesc=",sumenep
6631 write (2,*) xx,yy,zz
6632 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6633 de_dyy_num=(sumenep-sumene)/aincr
6635 write (2,*) "yy+ sumene from enesc=",sumenep
6638 write (2,*) xx,yy,zz
6639 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6640 de_dzz_num=(sumenep-sumene)/aincr
6642 write (2,*) "zz+ sumene from enesc=",sumenep
6643 costsave=cost2tab(i+1)
6644 sintsave=sint2tab(i+1)
6645 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6646 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6647 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6648 de_dt_num=(sumenep-sumene)/aincr
6649 write (2,*) " t+ sumene from enesc=",sumenep
6650 cost2tab(i+1)=costsave
6651 sint2tab(i+1)=sintsave
6652 ! End of diagnostics section.
6655 ! Compute the gradient of esc
6657 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6658 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6659 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6660 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6661 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6662 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6663 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6664 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6665 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6666 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6667 *(pom_s1/dscp1+pom_s16*dscp1**4)
6668 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6669 *(pom_s2/dscp2+pom_s26*dscp2**4)
6670 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6671 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6672 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6674 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6675 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6676 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6678 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6679 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6682 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6685 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6686 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6687 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6689 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6690 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6691 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6692 +x(59)*zz**2 +x(60)*xx*zz
6693 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6694 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6697 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
6700 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6701 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6702 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6703 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6704 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6705 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6706 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6707 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6709 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
6712 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6713 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6714 +pom1*pom_dt1+pom2*pom_dt2
6716 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
6720 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6721 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6722 cosfac2xx=cosfac2*xx
6723 sinfac2yy=sinfac2*yy
6725 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6727 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6729 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6730 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6731 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6732 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6733 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6734 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6735 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6736 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6737 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6738 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6742 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6743 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6744 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6745 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6748 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6749 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6750 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6751 (z_prime(k)-zz*dC_norm(k,i+nres))
6753 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6754 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6758 dXX_Ctab(k,i)=dXX_Ci(k)
6759 dXX_C1tab(k,i)=dXX_Ci1(k)
6760 dYY_Ctab(k,i)=dYY_Ci(k)
6761 dYY_C1tab(k,i)=dYY_Ci1(k)
6762 dZZ_Ctab(k,i)=dZZ_Ci(k)
6763 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6764 dXX_XYZtab(k,i)=dXX_XYZ(k)
6765 dYY_XYZtab(k,i)=dYY_XYZ(k)
6766 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6770 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6771 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6772 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6773 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6774 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6776 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6777 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6778 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6779 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6780 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6781 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6782 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6783 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6785 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6786 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6788 ! to check gradient call subroutine check_grad
6794 !-----------------------------------------------------------------------------
6795 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6797 real(kind=8),dimension(65) :: x
6798 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6799 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6801 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6802 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6804 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6805 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6807 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6808 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6809 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6810 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6811 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6813 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6814 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6815 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6816 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6817 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6819 dsc_i = 0.743d0+x(61)
6821 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6822 *(xx*cost2+yy*sint2))
6823 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6824 *(xx*cost2-yy*sint2))
6825 s1=(1+x(63))/(0.1d0 + dscp1)
6826 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6827 s2=(1+x(65))/(0.1d0 + dscp2)
6828 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6829 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6830 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6835 !-----------------------------------------------------------------------------
6836 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6838 ! This procedure calculates two-body contact function g(rij) and its derivative:
6841 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6844 ! where x=(rij-r0ij)/delta
6846 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6849 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6850 real(kind=8) :: x,x2,x4,delta
6854 if (x.lt.-1.0D0) then
6857 else if (x.le.1.0D0) then
6860 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6861 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6867 end subroutine gcont
6868 !-----------------------------------------------------------------------------
6869 subroutine splinthet(theti,delta,ss,ssder)
6870 ! implicit real*8 (a-h,o-z)
6871 ! include 'DIMENSIONS'
6872 ! include 'COMMON.VAR'
6873 ! include 'COMMON.GEO'
6874 real(kind=8) :: theti,delta,ss,ssder
6875 real(kind=8) :: thetup,thetlow
6878 if (theti.gt.pipol) then
6879 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6881 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6885 end subroutine splinthet
6886 !-----------------------------------------------------------------------------
6887 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6889 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6890 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6891 a1=fprim0*delta/(f1-f0)
6897 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6898 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6900 end subroutine spline1
6901 !-----------------------------------------------------------------------------
6902 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6904 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6905 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6910 a2=3*(f1x-f0x)-2*fprim0x*delta
6911 a3=fprim0x*delta-2*(f1x-f0x)
6912 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6914 end subroutine spline2
6915 !-----------------------------------------------------------------------------
6917 !-----------------------------------------------------------------------------
6918 subroutine etor(etors,edihcnstr)
6919 ! implicit real*8 (a-h,o-z)
6920 ! include 'DIMENSIONS'
6921 ! include 'COMMON.VAR'
6922 ! include 'COMMON.GEO'
6923 ! include 'COMMON.LOCAL'
6924 ! include 'COMMON.TORSION'
6925 ! include 'COMMON.INTERACT'
6926 ! include 'COMMON.DERIV'
6927 ! include 'COMMON.CHAIN'
6928 ! include 'COMMON.NAMES'
6929 ! include 'COMMON.IOUNITS'
6930 ! include 'COMMON.FFIELD'
6931 ! include 'COMMON.TORCNSTR'
6932 ! include 'COMMON.CONTROL'
6933 real(kind=8) :: etors,edihcnstr
6937 real(kind=8) :: phii,fac,etors_ii
6939 ! Set lprn=.true. for debugging
6943 do i=iphi_start,iphi_end
6945 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
6946 .or. itype(i,1).eq.ntyp1) cycle
6947 itori=itortyp(itype(i-2,1))
6948 itori1=itortyp(itype(i-1,1))
6951 ! Proline-Proline pair is a special case...
6952 if (itori.eq.3 .and. itori1.eq.3) then
6953 if (phii.gt.-dwapi3) then
6955 fac=1.0D0/(1.0D0-cosphi)
6956 etorsi=v1(1,3,3)*fac
6957 etorsi=etorsi+etorsi
6958 etors=etors+etorsi-v1(1,3,3)
6959 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6960 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6963 v1ij=v1(j+1,itori,itori1)
6964 v2ij=v2(j+1,itori,itori1)
6967 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6968 if (energy_dec) etors_ii=etors_ii+ &
6969 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6970 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6974 v1ij=v1(j,itori,itori1)
6975 v2ij=v2(j,itori,itori1)
6978 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6979 if (energy_dec) etors_ii=etors_ii+ &
6980 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6981 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6984 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6987 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6988 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6989 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6990 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6991 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6993 ! 6/20/98 - dihedral angle constraints
6996 itori=idih_constr(i)
6999 if (difi.gt.drange(i)) then
7001 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7002 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7003 else if (difi.lt.-drange(i)) then
7005 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7006 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7008 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7009 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7011 ! write (iout,*) 'edihcnstr',edihcnstr
7014 !-----------------------------------------------------------------------------
7015 subroutine etor_d(etors_d)
7016 real(kind=8) :: etors_d
7019 end subroutine etor_d
7021 !-----------------------------------------------------------------------------
7022 subroutine etor(etors,edihcnstr)
7023 ! implicit real*8 (a-h,o-z)
7024 ! include 'DIMENSIONS'
7025 ! include 'COMMON.VAR'
7026 ! include 'COMMON.GEO'
7027 ! include 'COMMON.LOCAL'
7028 ! include 'COMMON.TORSION'
7029 ! include 'COMMON.INTERACT'
7030 ! include 'COMMON.DERIV'
7031 ! include 'COMMON.CHAIN'
7032 ! include 'COMMON.NAMES'
7033 ! include 'COMMON.IOUNITS'
7034 ! include 'COMMON.FFIELD'
7035 ! include 'COMMON.TORCNSTR'
7036 ! include 'COMMON.CONTROL'
7037 real(kind=8) :: etors,edihcnstr
7040 integer :: i,j,iblock,itori,itori1
7041 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
7042 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
7043 ! Set lprn=.true. for debugging
7047 do i=iphi_start,iphi_end
7048 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
7049 .or. itype(i-3,1).eq.ntyp1 &
7050 .or. itype(i,1).eq.ntyp1) cycle
7052 if (iabs(itype(i,1)).eq.20) then
7057 itori=itortyp(itype(i-2,1))
7058 itori1=itortyp(itype(i-1,1))
7061 ! Regular cosine and sine terms
7062 do j=1,nterm(itori,itori1,iblock)
7063 v1ij=v1(j,itori,itori1,iblock)
7064 v2ij=v2(j,itori,itori1,iblock)
7067 etors=etors+v1ij*cosphi+v2ij*sinphi
7068 if (energy_dec) etors_ii=etors_ii+ &
7069 v1ij*cosphi+v2ij*sinphi
7070 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7074 ! E = SUM ----------------------------------- - v1
7075 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7077 cosphi=dcos(0.5d0*phii)
7078 sinphi=dsin(0.5d0*phii)
7079 do j=1,nlor(itori,itori1,iblock)
7080 vl1ij=vlor1(j,itori,itori1)
7081 vl2ij=vlor2(j,itori,itori1)
7082 vl3ij=vlor3(j,itori,itori1)
7083 pom=vl2ij*cosphi+vl3ij*sinphi
7084 pom1=1.0d0/(pom*pom+1.0d0)
7085 etors=etors+vl1ij*pom1
7086 if (energy_dec) etors_ii=etors_ii+ &
7089 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7091 ! Subtract the constant term
7092 etors=etors-v0(itori,itori1,iblock)
7093 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7094 'etor',i,etors_ii-v0(itori,itori1,iblock)
7096 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7097 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
7098 (v1(j,itori,itori1,iblock),j=1,6),&
7099 (v2(j,itori,itori1,iblock),j=1,6)
7100 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7101 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7103 ! 6/20/98 - dihedral angle constraints
7105 ! do i=1,ndih_constr
7106 do i=idihconstr_start,idihconstr_end
7107 itori=idih_constr(i)
7109 difi=pinorm(phii-phi0(i))
7110 if (difi.gt.drange(i)) then
7112 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7113 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7114 else if (difi.lt.-drange(i)) then
7116 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7117 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7121 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
7122 !d & rad2deg*phi0(i), rad2deg*drange(i),
7123 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7125 !d write (iout,*) 'edihcnstr',edihcnstr
7128 !-----------------------------------------------------------------------------
7129 subroutine etor_d(etors_d)
7130 ! 6/23/01 Compute double torsional energy
7131 ! implicit real*8 (a-h,o-z)
7132 ! include 'DIMENSIONS'
7133 ! include 'COMMON.VAR'
7134 ! include 'COMMON.GEO'
7135 ! include 'COMMON.LOCAL'
7136 ! include 'COMMON.TORSION'
7137 ! include 'COMMON.INTERACT'
7138 ! include 'COMMON.DERIV'
7139 ! include 'COMMON.CHAIN'
7140 ! include 'COMMON.NAMES'
7141 ! include 'COMMON.IOUNITS'
7142 ! include 'COMMON.FFIELD'
7143 ! include 'COMMON.TORCNSTR'
7144 real(kind=8) :: etors_d,etors_d_ii
7147 integer :: i,j,k,l,itori,itori1,itori2,iblock
7148 real(kind=8) :: phii,phii1,gloci1,gloci2,&
7149 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
7150 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
7151 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
7152 ! Set lprn=.true. for debugging
7156 ! write(iout,*) "a tu??"
7157 do i=iphid_start,iphid_end
7159 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
7160 .or. itype(i-3,1).eq.ntyp1 &
7161 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
7162 itori=itortyp(itype(i-2,1))
7163 itori1=itortyp(itype(i-1,1))
7164 itori2=itortyp(itype(i,1))
7170 if (iabs(itype(i+1,1)).eq.20) iblock=2
7172 ! Regular cosine and sine terms
7173 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7174 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7175 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7176 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7177 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7178 cosphi1=dcos(j*phii)
7179 sinphi1=dsin(j*phii)
7180 cosphi2=dcos(j*phii1)
7181 sinphi2=dsin(j*phii1)
7182 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
7183 v2cij*cosphi2+v2sij*sinphi2
7184 if (energy_dec) etors_d_ii=etors_d_ii+ &
7185 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
7186 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7187 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7189 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7191 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7192 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7193 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7194 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7195 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7196 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7197 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7198 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7199 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
7200 v1sdij*sinphi1p2+v2sdij*sinphi1m2
7201 if (energy_dec) etors_d_ii=etors_d_ii+ &
7202 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
7203 v1sdij*sinphi1p2+v2sdij*sinphi1m2
7204 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
7205 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7206 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
7207 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7210 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7211 'etor_d',i,etors_d_ii
7212 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7213 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7216 end subroutine etor_d
7218 !-----------------------------------------------------------------------------
7219 subroutine eback_sc_corr(esccor)
7220 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
7221 ! conformational states; temporarily implemented as differences
7222 ! between UNRES torsional potentials (dependent on three types of
7223 ! residues) and the torsional potentials dependent on all 20 types
7224 ! of residues computed from AM1 energy surfaces of terminally-blocked
7225 ! amino-acid residues.
7226 ! implicit real*8 (a-h,o-z)
7227 ! include 'DIMENSIONS'
7228 ! include 'COMMON.VAR'
7229 ! include 'COMMON.GEO'
7230 ! include 'COMMON.LOCAL'
7231 ! include 'COMMON.TORSION'
7232 ! include 'COMMON.SCCOR'
7233 ! include 'COMMON.INTERACT'
7234 ! include 'COMMON.DERIV'
7235 ! include 'COMMON.CHAIN'
7236 ! include 'COMMON.NAMES'
7237 ! include 'COMMON.IOUNITS'
7238 ! include 'COMMON.FFIELD'
7239 ! include 'COMMON.CONTROL'
7240 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
7243 integer :: i,interty,j,isccori,isccori1,intertyp
7244 ! Set lprn=.true. for debugging
7247 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7249 do i=itau_start,itau_end
7250 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
7252 isccori=isccortyp(itype(i-2,1))
7253 isccori1=isccortyp(itype(i-1,1))
7255 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7257 do intertyp=1,3 !intertyp
7259 !c Added 09 May 2012 (Adasko)
7260 !c Intertyp means interaction type of backbone mainchain correlation:
7261 ! 1 = SC...Ca...Ca...Ca
7262 ! 2 = Ca...Ca...Ca...SC
7263 ! 3 = SC...Ca...Ca...SCi
7265 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
7266 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
7267 (itype(i-1,1).eq.ntyp1))) &
7268 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
7269 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
7270 .or.(itype(i,1).eq.ntyp1))) &
7271 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
7272 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
7273 (itype(i-3,1).eq.ntyp1)))) cycle
7274 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
7275 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
7277 do j=1,nterm_sccor(isccori,isccori1)
7278 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7279 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7280 cosphi=dcos(j*tauangle(intertyp,i))
7281 sinphi=dsin(j*tauangle(intertyp,i))
7282 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7283 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7284 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7286 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
7287 'esccor',i,intertyp,esccor_ii
7288 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7289 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7291 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7292 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
7293 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
7294 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7295 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7300 end subroutine eback_sc_corr
7301 !-----------------------------------------------------------------------------
7302 subroutine multibody(ecorr)
7303 ! This subroutine calculates multi-body contributions to energy following
7304 ! the idea of Skolnick et al. If side chains I and J make a contact and
7305 ! at the same time side chains I+1 and J+1 make a contact, an extra
7306 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7307 ! implicit real*8 (a-h,o-z)
7308 ! include 'DIMENSIONS'
7309 ! include 'COMMON.IOUNITS'
7310 ! include 'COMMON.DERIV'
7311 ! include 'COMMON.INTERACT'
7312 ! include 'COMMON.CONTACTS'
7313 real(kind=8),dimension(3) :: gx,gx1
7315 real(kind=8) :: ecorr
7316 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
7317 ! Set lprn=.true. for debugging
7321 write (iout,'(a)') 'Contact function values:'
7323 write (iout,'(i2,20(1x,i2,f10.5))') &
7324 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7329 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7330 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7342 num_conti=num_cont(i)
7343 num_conti1=num_cont(i1)
7348 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7349 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7350 !d & ' ishift=',ishift
7351 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7352 ! The system gains extra energy.
7353 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7354 endif ! j1==j+-ishift
7362 end subroutine multibody
7363 !-----------------------------------------------------------------------------
7364 real(kind=8) function esccorr(i,j,k,l,jj,kk)
7365 ! implicit real*8 (a-h,o-z)
7366 ! include 'DIMENSIONS'
7367 ! include 'COMMON.IOUNITS'
7368 ! include 'COMMON.DERIV'
7369 ! include 'COMMON.INTERACT'
7370 ! include 'COMMON.CONTACTS'
7371 real(kind=8),dimension(3) :: gx,gx1
7373 integer :: i,j,k,l,jj,kk,m,ll
7374 real(kind=8) :: eij,ekl
7378 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7379 ! Calculate the multi-body contribution to energy.
7380 ! Calculate multi-body contributions to the gradient.
7381 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7382 !d & k,l,(gacont(m,kk,k),m=1,3)
7384 gx(m) =ekl*gacont(m,jj,i)
7385 gx1(m)=eij*gacont(m,kk,k)
7386 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7387 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7388 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7389 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7393 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7398 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7403 end function esccorr
7404 !-----------------------------------------------------------------------------
7405 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7406 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7407 ! implicit real*8 (a-h,o-z)
7408 ! include 'DIMENSIONS'
7409 ! include 'COMMON.IOUNITS'
7412 ! integer :: maxconts !max_cont=maxconts =nres/4
7413 integer,parameter :: max_dim=26
7414 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7415 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7416 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7417 !el common /przechowalnia/ zapas
7418 integer :: status(MPI_STATUS_SIZE)
7419 integer,dimension((nres/4)*2) :: req !maxconts*2
7420 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
7422 ! include 'COMMON.SETUP'
7423 ! include 'COMMON.FFIELD'
7424 ! include 'COMMON.DERIV'
7425 ! include 'COMMON.INTERACT'
7426 ! include 'COMMON.CONTACTS'
7427 ! include 'COMMON.CONTROL'
7428 ! include 'COMMON.LOCAL'
7429 real(kind=8),dimension(3) :: gx,gx1
7430 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
7431 logical :: lprn,ldone
7433 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
7434 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
7436 ! Set lprn=.true. for debugging
7440 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7443 if (nfgtasks.le.1) goto 30
7445 write (iout,'(a)') 'Contact function values before RECEIVE:'
7447 write (iout,'(2i3,50(1x,i2,f5.2))') &
7448 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7453 do i=1,ntask_cont_from
7456 do i=1,ntask_cont_to
7459 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7461 ! Make the list of contacts to send to send to other procesors
7462 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7464 do i=iturn3_start,iturn3_end
7465 ! write (iout,*) "make contact list turn3",i," num_cont",
7467 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7469 do i=iturn4_start,iturn4_end
7470 ! write (iout,*) "make contact list turn4",i," num_cont",
7472 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7476 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7478 do j=1,num_cont_hb(i)
7481 iproc=iint_sent_local(k,jjc,ii)
7482 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7483 if (iproc.gt.0) then
7484 ncont_sent(iproc)=ncont_sent(iproc)+1
7485 nn=ncont_sent(iproc)
7487 zapas(2,nn,iproc)=jjc
7488 zapas(3,nn,iproc)=facont_hb(j,i)
7489 zapas(4,nn,iproc)=ees0p(j,i)
7490 zapas(5,nn,iproc)=ees0m(j,i)
7491 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7492 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7493 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7494 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7495 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7496 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7497 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7498 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7499 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7500 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7501 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7502 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7503 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7504 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7505 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7506 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7507 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7508 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7509 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7510 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7511 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7518 "Numbers of contacts to be sent to other processors",&
7519 (ncont_sent(i),i=1,ntask_cont_to)
7520 write (iout,*) "Contacts sent"
7521 do ii=1,ntask_cont_to
7523 iproc=itask_cont_to(ii)
7524 write (iout,*) nn," contacts to processor",iproc,&
7525 " of CONT_TO_COMM group"
7527 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7535 CorrelID1=nfgtasks+fg_rank+1
7537 ! Receive the numbers of needed contacts from other processors
7538 do ii=1,ntask_cont_from
7539 iproc=itask_cont_from(ii)
7541 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7542 FG_COMM,req(ireq),IERR)
7544 ! write (iout,*) "IRECV ended"
7546 ! Send the number of contacts needed by other processors
7547 do ii=1,ntask_cont_to
7548 iproc=itask_cont_to(ii)
7550 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7551 FG_COMM,req(ireq),IERR)
7553 ! write (iout,*) "ISEND ended"
7554 ! write (iout,*) "number of requests (nn)",ireq
7557 call MPI_Waitall(ireq,req,status_array,ierr)
7559 ! & "Numbers of contacts to be received from other processors",
7560 ! & (ncont_recv(i),i=1,ntask_cont_from)
7564 do ii=1,ntask_cont_from
7565 iproc=itask_cont_from(ii)
7567 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7568 ! & " of CONT_TO_COMM group"
7572 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7573 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7574 ! write (iout,*) "ireq,req",ireq,req(ireq)
7577 ! Send the contacts to processors that need them
7578 do ii=1,ntask_cont_to
7579 iproc=itask_cont_to(ii)
7581 ! write (iout,*) nn," contacts to processor",iproc,
7582 ! & " of CONT_TO_COMM group"
7585 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7586 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7587 ! write (iout,*) "ireq,req",ireq,req(ireq)
7589 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7593 ! write (iout,*) "number of requests (contacts)",ireq
7594 ! write (iout,*) "req",(req(i),i=1,4)
7597 call MPI_Waitall(ireq,req,status_array,ierr)
7598 do iii=1,ntask_cont_from
7599 iproc=itask_cont_from(iii)
7602 write (iout,*) "Received",nn," contacts from processor",iproc,&
7603 " of CONT_FROM_COMM group"
7606 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7611 ii=zapas_recv(1,i,iii)
7612 ! Flag the received contacts to prevent double-counting
7613 jj=-zapas_recv(2,i,iii)
7614 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7616 nnn=num_cont_hb(ii)+1
7619 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7620 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7621 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7622 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7623 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7624 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7625 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7626 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7627 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7628 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7629 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7630 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7631 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7632 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7633 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7634 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7635 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7636 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7637 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7638 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7639 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7640 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7641 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7642 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7647 write (iout,'(a)') 'Contact function values after receive:'
7649 write (iout,'(2i3,50(1x,i3,f5.2))') &
7650 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7658 write (iout,'(a)') 'Contact function values:'
7660 write (iout,'(2i3,50(1x,i3,f5.2))') &
7661 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7667 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7668 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7669 ! Remove the loop below after debugging !!!
7676 ! Calculate the local-electrostatic correlation terms
7677 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7679 num_conti=num_cont_hb(i)
7680 num_conti1=num_cont_hb(i+1)
7687 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7688 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7689 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7690 .or. j.lt.0 .and. j1.gt.0) .and. &
7691 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7692 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7693 ! The system gains extra energy.
7694 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7695 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7696 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7698 else if (j1.eq.j) then
7699 ! Contacts I-J and I-(J+1) occur simultaneously.
7700 ! The system loses extra energy.
7701 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7706 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7707 ! & ' jj=',jj,' kk=',kk
7709 ! Contacts I-J and (I+1)-J occur simultaneously.
7710 ! The system loses extra energy.
7711 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7717 end subroutine multibody_hb
7718 !-----------------------------------------------------------------------------
7719 subroutine add_hb_contact(ii,jj,itask)
7720 ! implicit real*8 (a-h,o-z)
7721 ! include "DIMENSIONS"
7722 ! include "COMMON.IOUNITS"
7723 ! include "COMMON.CONTACTS"
7724 ! integer,parameter :: maxconts=nres/4
7725 integer,parameter :: max_dim=26
7726 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7727 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7728 ! common /przechowalnia/ zapas
7729 integer :: i,j,ii,jj,iproc,nn,jjc
7730 integer,dimension(4) :: itask
7731 ! write (iout,*) "itask",itask
7734 if (iproc.gt.0) then
7735 do j=1,num_cont_hb(ii)
7737 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7739 ncont_sent(iproc)=ncont_sent(iproc)+1
7740 nn=ncont_sent(iproc)
7741 zapas(1,nn,iproc)=ii
7742 zapas(2,nn,iproc)=jjc
7743 zapas(3,nn,iproc)=facont_hb(j,ii)
7744 zapas(4,nn,iproc)=ees0p(j,ii)
7745 zapas(5,nn,iproc)=ees0m(j,ii)
7746 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7747 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7748 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7749 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7750 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7751 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7752 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7753 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7754 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7755 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7756 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7757 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7758 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7759 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7760 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7761 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7762 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7763 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7764 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7765 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7766 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7773 end subroutine add_hb_contact
7774 !-----------------------------------------------------------------------------
7775 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7776 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7777 ! implicit real*8 (a-h,o-z)
7778 ! include 'DIMENSIONS'
7779 ! include 'COMMON.IOUNITS'
7780 integer,parameter :: max_dim=70
7783 ! integer :: maxconts !max_cont=maxconts=nres/4
7784 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7785 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7786 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7787 ! common /przechowalnia/ zapas
7788 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7789 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7792 ! include 'COMMON.SETUP'
7793 ! include 'COMMON.FFIELD'
7794 ! include 'COMMON.DERIV'
7795 ! include 'COMMON.LOCAL'
7796 ! include 'COMMON.INTERACT'
7797 ! include 'COMMON.CONTACTS'
7798 ! include 'COMMON.CHAIN'
7799 ! include 'COMMON.CONTROL'
7800 real(kind=8),dimension(3) :: gx,gx1
7801 integer,dimension(nres) :: num_cont_hb_old
7802 logical :: lprn,ldone
7803 !EL double precision eello4,eello5,eelo6,eello_turn6
7804 !EL external eello4,eello5,eello6,eello_turn6
7806 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7807 j1,jp1,i1,num_conti1
7808 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7809 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7811 ! Set lprn=.true. for debugging
7816 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7818 num_cont_hb_old(i)=num_cont_hb(i)
7822 if (nfgtasks.le.1) goto 30
7824 write (iout,'(a)') 'Contact function values before RECEIVE:'
7826 write (iout,'(2i3,50(1x,i2,f5.2))') &
7827 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7832 do i=1,ntask_cont_from
7835 do i=1,ntask_cont_to
7838 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7840 ! Make the list of contacts to send to send to other procesors
7841 do i=iturn3_start,iturn3_end
7842 ! write (iout,*) "make contact list turn3",i," num_cont",
7844 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7846 do i=iturn4_start,iturn4_end
7847 ! write (iout,*) "make contact list turn4",i," num_cont",
7849 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7853 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7855 do j=1,num_cont_hb(i)
7858 iproc=iint_sent_local(k,jjc,ii)
7859 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7860 if (iproc.ne.0) then
7861 ncont_sent(iproc)=ncont_sent(iproc)+1
7862 nn=ncont_sent(iproc)
7864 zapas(2,nn,iproc)=jjc
7865 zapas(3,nn,iproc)=d_cont(j,i)
7869 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7874 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7882 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7893 "Numbers of contacts to be sent to other processors",&
7894 (ncont_sent(i),i=1,ntask_cont_to)
7895 write (iout,*) "Contacts sent"
7896 do ii=1,ntask_cont_to
7898 iproc=itask_cont_to(ii)
7899 write (iout,*) nn," contacts to processor",iproc,&
7900 " of CONT_TO_COMM group"
7902 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7910 CorrelID1=nfgtasks+fg_rank+1
7912 ! Receive the numbers of needed contacts from other processors
7913 do ii=1,ntask_cont_from
7914 iproc=itask_cont_from(ii)
7916 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7917 FG_COMM,req(ireq),IERR)
7919 ! write (iout,*) "IRECV ended"
7921 ! Send the number of contacts needed by other processors
7922 do ii=1,ntask_cont_to
7923 iproc=itask_cont_to(ii)
7925 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7926 FG_COMM,req(ireq),IERR)
7928 ! write (iout,*) "ISEND ended"
7929 ! write (iout,*) "number of requests (nn)",ireq
7932 call MPI_Waitall(ireq,req,status_array,ierr)
7934 ! & "Numbers of contacts to be received from other processors",
7935 ! & (ncont_recv(i),i=1,ntask_cont_from)
7939 do ii=1,ntask_cont_from
7940 iproc=itask_cont_from(ii)
7942 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7943 ! & " of CONT_TO_COMM group"
7947 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7948 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7949 ! write (iout,*) "ireq,req",ireq,req(ireq)
7952 ! Send the contacts to processors that need them
7953 do ii=1,ntask_cont_to
7954 iproc=itask_cont_to(ii)
7956 ! write (iout,*) nn," contacts to processor",iproc,
7957 ! & " of CONT_TO_COMM group"
7960 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7961 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7962 ! write (iout,*) "ireq,req",ireq,req(ireq)
7964 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7968 ! write (iout,*) "number of requests (contacts)",ireq
7969 ! write (iout,*) "req",(req(i),i=1,4)
7972 call MPI_Waitall(ireq,req,status_array,ierr)
7973 do iii=1,ntask_cont_from
7974 iproc=itask_cont_from(iii)
7977 write (iout,*) "Received",nn," contacts from processor",iproc,&
7978 " of CONT_FROM_COMM group"
7981 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7986 ii=zapas_recv(1,i,iii)
7987 ! Flag the received contacts to prevent double-counting
7988 jj=-zapas_recv(2,i,iii)
7989 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7991 nnn=num_cont_hb(ii)+1
7994 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7998 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8003 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8011 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8020 write (iout,'(a)') 'Contact function values after receive:'
8022 write (iout,'(2i3,50(1x,i3,5f6.3))') &
8023 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
8024 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8031 write (iout,'(a)') 'Contact function values:'
8033 write (iout,'(2i3,50(1x,i2,5f6.3))') &
8034 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
8035 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8042 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
8043 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
8044 ! Remove the loop below after debugging !!!
8051 ! Calculate the dipole-dipole interaction energies
8052 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8053 do i=iatel_s,iatel_e+1
8054 num_conti=num_cont_hb(i)
8063 ! Calculate the local-electrostatic correlation terms
8064 ! write (iout,*) "gradcorr5 in eello5 before loop"
8066 ! write (iout,'(i5,3f10.5)')
8067 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8069 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8070 ! write (iout,*) "corr loop i",i
8072 num_conti=num_cont_hb(i)
8073 num_conti1=num_cont_hb(i+1)
8080 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8081 ! & ' jj=',jj,' kk=',kk
8082 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
8083 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
8084 .or. j.lt.0 .and. j1.gt.0) .and. &
8085 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8086 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8087 ! The system gains extra energy.
8089 sqd1=dsqrt(d_cont(jj,i))
8090 sqd2=dsqrt(d_cont(kk,i1))
8091 sred_geom = sqd1*sqd2
8092 IF (sred_geom.lt.cutoff_corr) THEN
8093 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
8095 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8096 !d & ' jj=',jj,' kk=',kk
8097 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8098 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8100 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8101 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8104 !d write (iout,*) 'sred_geom=',sred_geom,
8105 !d & ' ekont=',ekont,' fprim=',fprimcont,
8106 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8107 !d write (iout,*) "g_contij",g_contij
8108 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8109 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8110 call calc_eello(i,jp,i+1,jp1,jj,kk)
8111 if (wcorr4.gt.0.0d0) &
8112 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8113 if (energy_dec.and.wcorr4.gt.0.0d0) &
8114 write (iout,'(a6,4i5,0pf7.3)') &
8115 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8116 ! write (iout,*) "gradcorr5 before eello5"
8118 ! write (iout,'(i5,3f10.5)')
8119 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8121 if (wcorr5.gt.0.0d0) &
8122 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8123 ! write (iout,*) "gradcorr5 after eello5"
8125 ! write (iout,'(i5,3f10.5)')
8126 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8128 if (energy_dec.and.wcorr5.gt.0.0d0) &
8129 write (iout,'(a6,4i5,0pf7.3)') &
8130 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8131 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8132 !d write(2,*)'ijkl',i,jp,i+1,jp1
8133 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
8134 .or. wturn6.eq.0.0d0))then
8135 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8136 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8137 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
8138 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8139 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8140 !d & 'ecorr6=',ecorr6
8141 !d write (iout,'(4e15.5)') sred_geom,
8142 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8143 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8144 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8145 else if (wturn6.gt.0.0d0 &
8146 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8147 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8148 eturn6=eturn6+eello_turn6(i,jj,kk)
8149 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
8150 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8151 !d write (2,*) 'multibody_eello:eturn6',eturn6
8160 num_cont_hb(i)=num_cont_hb_old(i)
8162 ! write (iout,*) "gradcorr5 in eello5"
8164 ! write (iout,'(i5,3f10.5)')
8165 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8168 end subroutine multibody_eello
8169 !-----------------------------------------------------------------------------
8170 subroutine add_hb_contact_eello(ii,jj,itask)
8171 ! implicit real*8 (a-h,o-z)
8172 ! include "DIMENSIONS"
8173 ! include "COMMON.IOUNITS"
8174 ! include "COMMON.CONTACTS"
8175 ! integer,parameter :: maxconts=nres/4
8176 integer,parameter :: max_dim=70
8177 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
8178 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
8179 ! common /przechowalnia/ zapas
8181 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
8182 integer,dimension(4) ::itask
8183 ! write (iout,*) "itask",itask
8186 if (iproc.gt.0) then
8187 do j=1,num_cont_hb(ii)
8189 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8191 ncont_sent(iproc)=ncont_sent(iproc)+1
8192 nn=ncont_sent(iproc)
8193 zapas(1,nn,iproc)=ii
8194 zapas(2,nn,iproc)=jjc
8195 zapas(3,nn,iproc)=d_cont(j,ii)
8199 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8204 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8212 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8223 end subroutine add_hb_contact_eello
8224 !-----------------------------------------------------------------------------
8225 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8226 ! implicit real*8 (a-h,o-z)
8227 ! include 'DIMENSIONS'
8228 ! include 'COMMON.IOUNITS'
8229 ! include 'COMMON.DERIV'
8230 ! include 'COMMON.INTERACT'
8231 ! include 'COMMON.CONTACTS'
8232 real(kind=8),dimension(3) :: gx,gx1
8235 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
8236 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
8237 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
8238 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
8249 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8250 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8251 ! Following 4 lines for diagnostics.
8256 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8257 ! & 'Contacts ',i,j,
8258 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8259 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8261 ! Calculate the multi-body contribution to energy.
8262 ! ecorr=ecorr+ekont*ees
8263 ! Calculate multi-body contributions to the gradient.
8264 coeffpees0pij=coeffp*ees0pij
8265 coeffmees0mij=coeffm*ees0mij
8266 coeffpees0pkl=coeffp*ees0pkl
8267 coeffmees0mkl=coeffm*ees0mkl
8269 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8270 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
8271 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
8272 coeffmees0mkl*gacontm_hb1(ll,jj,i))
8273 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
8274 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
8275 coeffmees0mkl*gacontm_hb2(ll,jj,i))
8276 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8277 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
8278 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
8279 coeffmees0mij*gacontm_hb1(ll,kk,k))
8280 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
8281 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
8282 coeffmees0mij*gacontm_hb2(ll,kk,k))
8283 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
8284 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
8285 coeffmees0mkl*gacontm_hb3(ll,jj,i))
8286 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8287 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8288 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
8289 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
8290 coeffmees0mij*gacontm_hb3(ll,kk,k))
8291 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8292 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8293 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8298 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8299 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
8300 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8301 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8306 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8307 !grad & ees*eij*gacont_hbr(ll,kk,k)-
8308 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8309 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8312 ! write (iout,*) "ehbcorr",ekont*ees
8314 if (shield_mode.gt.0) then
8317 !C print *,i,j,fac_shield(i),fac_shield(j),
8318 !C &fac_shield(k),fac_shield(l)
8319 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
8320 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8321 do ilist=1,ishield_list(i)
8322 iresshield=shield_list(ilist,i)
8324 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8325 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8327 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8328 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8332 do ilist=1,ishield_list(j)
8333 iresshield=shield_list(ilist,j)
8335 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8336 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8338 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8339 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8344 do ilist=1,ishield_list(k)
8345 iresshield=shield_list(ilist,k)
8347 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8348 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8350 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8351 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8355 do ilist=1,ishield_list(l)
8356 iresshield=shield_list(ilist,l)
8358 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8359 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8361 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8362 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8367 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
8368 grad_shield(m,i)*ehbcorr/fac_shield(i)
8369 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
8370 grad_shield(m,j)*ehbcorr/fac_shield(j)
8371 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
8372 grad_shield(m,i)*ehbcorr/fac_shield(i)
8373 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
8374 grad_shield(m,j)*ehbcorr/fac_shield(j)
8376 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
8377 grad_shield(m,k)*ehbcorr/fac_shield(k)
8378 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
8379 grad_shield(m,l)*ehbcorr/fac_shield(l)
8380 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
8381 grad_shield(m,k)*ehbcorr/fac_shield(k)
8382 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
8383 grad_shield(m,l)*ehbcorr/fac_shield(l)
8389 end function ehbcorr
8391 !-----------------------------------------------------------------------------
8392 subroutine dipole(i,j,jj)
8393 ! implicit real*8 (a-h,o-z)
8394 ! include 'DIMENSIONS'
8395 ! include 'COMMON.IOUNITS'
8396 ! include 'COMMON.CHAIN'
8397 ! include 'COMMON.FFIELD'
8398 ! include 'COMMON.DERIV'
8399 ! include 'COMMON.INTERACT'
8400 ! include 'COMMON.CONTACTS'
8401 ! include 'COMMON.TORSION'
8402 ! include 'COMMON.VAR'
8403 ! include 'COMMON.GEO'
8404 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
8405 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
8406 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
8408 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
8409 allocate(dipderx(3,5,4,maxconts,nres))
8412 iti1 = itortyp(itype(i+1,1))
8413 if (j.lt.nres-1) then
8414 itj1 = itortyp(itype(j+1,1))
8419 dipi(iii,1)=Ub2(iii,i)
8420 dipderi(iii)=Ub2der(iii,i)
8421 dipi(iii,2)=b1(iii,iti1)
8422 dipj(iii,1)=Ub2(iii,j)
8423 dipderj(iii)=Ub2der(iii,j)
8424 dipj(iii,2)=b1(iii,itj1)
8428 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8431 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8438 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
8442 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8447 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8448 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8450 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8452 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8454 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8457 end subroutine dipole
8459 !-----------------------------------------------------------------------------
8460 subroutine calc_eello(i,j,k,l,jj,kk)
8462 ! This subroutine computes matrices and vectors needed to calculate
8463 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
8466 ! implicit real*8 (a-h,o-z)
8467 ! include 'DIMENSIONS'
8468 ! include 'COMMON.IOUNITS'
8469 ! include 'COMMON.CHAIN'
8470 ! include 'COMMON.DERIV'
8471 ! include 'COMMON.INTERACT'
8472 ! include 'COMMON.CONTACTS'
8473 ! include 'COMMON.TORSION'
8474 ! include 'COMMON.VAR'
8475 ! include 'COMMON.GEO'
8476 ! include 'COMMON.FFIELD'
8477 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
8478 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
8479 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
8482 !el common /kutas/ lprn
8483 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8484 !d & ' jj=',jj,' kk=',kk
8485 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8486 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8487 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8490 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8491 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8494 call transpose2(aa1(1,1),aa1t(1,1))
8495 call transpose2(aa2(1,1),aa2t(1,1))
8498 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
8499 aa1tder(1,1,lll,kkk))
8500 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
8501 aa2tder(1,1,lll,kkk))
8505 ! parallel orientation of the two CA-CA-CA frames.
8507 iti=itortyp(itype(i,1))
8511 itk1=itortyp(itype(k+1,1))
8512 itj=itortyp(itype(j,1))
8513 if (l.lt.nres-1) then
8514 itl1=itortyp(itype(l+1,1))
8518 ! A1 kernel(j+1) A2T
8520 !d write (iout,'(3f10.5,5x,3f10.5)')
8521 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8523 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8524 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
8525 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8526 ! Following matrices are needed only for 6-th order cumulants
8527 IF (wcorr6.gt.0.0d0) THEN
8528 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8529 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
8530 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8531 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8532 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
8533 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8534 ADtEAderx(1,1,1,1,1,1))
8536 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8537 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
8538 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8539 ADtEA1derx(1,1,1,1,1,1))
8541 ! End 6-th order cumulants
8544 !d write (2,*) 'In calc_eello6'
8546 !d write (2,*) 'iii=',iii
8548 !d write (2,*) 'kkk=',kkk
8550 !d write (2,'(3(2f10.5),5x)')
8551 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8556 call transpose2(EUgder(1,1,k),auxmat(1,1))
8557 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8558 call transpose2(EUg(1,1,k),auxmat(1,1))
8559 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8560 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8564 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8565 EAEAderx(1,1,lll,kkk,iii,1))
8569 ! A1T kernel(i+1) A2
8570 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8571 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
8572 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8573 ! Following matrices are needed only for 6-th order cumulants
8574 IF (wcorr6.gt.0.0d0) THEN
8575 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8576 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
8577 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8578 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8579 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
8580 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8581 ADtEAderx(1,1,1,1,1,2))
8582 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8583 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
8584 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8585 ADtEA1derx(1,1,1,1,1,2))
8587 ! End 6-th order cumulants
8588 call transpose2(EUgder(1,1,l),auxmat(1,1))
8589 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8590 call transpose2(EUg(1,1,l),auxmat(1,1))
8591 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8592 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8596 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8597 EAEAderx(1,1,lll,kkk,iii,2))
8602 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8603 ! They are needed only when the fifth- or the sixth-order cumulants are
8605 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8606 call transpose2(AEA(1,1,1),auxmat(1,1))
8607 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8608 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8609 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8610 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8611 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8612 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8613 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8614 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8615 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8616 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8617 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8618 call transpose2(AEA(1,1,2),auxmat(1,1))
8619 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8620 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8621 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8622 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8623 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8624 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8625 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8626 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8627 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8628 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8629 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8630 ! Calculate the Cartesian derivatives of the vectors.
8634 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8635 call matvec2(auxmat(1,1),b1(1,iti),&
8636 AEAb1derx(1,lll,kkk,iii,1,1))
8637 call matvec2(auxmat(1,1),Ub2(1,i),&
8638 AEAb2derx(1,lll,kkk,iii,1,1))
8639 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8640 AEAb1derx(1,lll,kkk,iii,2,1))
8641 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8642 AEAb2derx(1,lll,kkk,iii,2,1))
8643 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8644 call matvec2(auxmat(1,1),b1(1,itj),&
8645 AEAb1derx(1,lll,kkk,iii,1,2))
8646 call matvec2(auxmat(1,1),Ub2(1,j),&
8647 AEAb2derx(1,lll,kkk,iii,1,2))
8648 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8649 AEAb1derx(1,lll,kkk,iii,2,2))
8650 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8651 AEAb2derx(1,lll,kkk,iii,2,2))
8658 ! Antiparallel orientation of the two CA-CA-CA frames.
8660 iti=itortyp(itype(i,1))
8664 itk1=itortyp(itype(k+1,1))
8665 itl=itortyp(itype(l,1))
8666 itj=itortyp(itype(j,1))
8667 if (j.lt.nres-1) then
8668 itj1=itortyp(itype(j+1,1))
8672 ! A2 kernel(j-1)T A1T
8673 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8674 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8675 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8676 ! Following matrices are needed only for 6-th order cumulants
8677 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8678 j.eq.i+4 .and. l.eq.i+3)) THEN
8679 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8680 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8681 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8682 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8683 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8684 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8685 ADtEAderx(1,1,1,1,1,1))
8686 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8687 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8688 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8689 ADtEA1derx(1,1,1,1,1,1))
8691 ! End 6-th order cumulants
8692 call transpose2(EUgder(1,1,k),auxmat(1,1))
8693 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8694 call transpose2(EUg(1,1,k),auxmat(1,1))
8695 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8696 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8700 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8701 EAEAderx(1,1,lll,kkk,iii,1))
8705 ! A2T kernel(i+1)T A1
8706 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8707 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8708 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8709 ! Following matrices are needed only for 6-th order cumulants
8710 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8711 j.eq.i+4 .and. l.eq.i+3)) THEN
8712 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8713 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8714 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8715 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8716 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8717 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8718 ADtEAderx(1,1,1,1,1,2))
8719 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8720 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8721 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8722 ADtEA1derx(1,1,1,1,1,2))
8724 ! End 6-th order cumulants
8725 call transpose2(EUgder(1,1,j),auxmat(1,1))
8726 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8727 call transpose2(EUg(1,1,j),auxmat(1,1))
8728 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8729 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8733 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8734 EAEAderx(1,1,lll,kkk,iii,2))
8739 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8740 ! They are needed only when the fifth- or the sixth-order cumulants are
8742 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8743 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8744 call transpose2(AEA(1,1,1),auxmat(1,1))
8745 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8746 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8747 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8748 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8749 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8750 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8751 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8752 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8753 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8754 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8755 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8756 call transpose2(AEA(1,1,2),auxmat(1,1))
8757 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8758 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8759 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8760 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8761 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8762 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8763 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8764 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8765 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8766 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8767 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8768 ! Calculate the Cartesian derivatives of the vectors.
8772 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8773 call matvec2(auxmat(1,1),b1(1,iti),&
8774 AEAb1derx(1,lll,kkk,iii,1,1))
8775 call matvec2(auxmat(1,1),Ub2(1,i),&
8776 AEAb2derx(1,lll,kkk,iii,1,1))
8777 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8778 AEAb1derx(1,lll,kkk,iii,2,1))
8779 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8780 AEAb2derx(1,lll,kkk,iii,2,1))
8781 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8782 call matvec2(auxmat(1,1),b1(1,itl),&
8783 AEAb1derx(1,lll,kkk,iii,1,2))
8784 call matvec2(auxmat(1,1),Ub2(1,l),&
8785 AEAb2derx(1,lll,kkk,iii,1,2))
8786 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8787 AEAb1derx(1,lll,kkk,iii,2,2))
8788 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8789 AEAb2derx(1,lll,kkk,iii,2,2))
8797 end subroutine calc_eello
8798 !-----------------------------------------------------------------------------
8799 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8804 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8805 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8806 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8807 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8808 integer :: iii,kkk,lll
8811 !el common /kutas/ lprn
8812 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8814 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8817 !d if (lprn) write (2,*) 'In kernel'
8819 !d if (lprn) write (2,*) 'kkk=',kkk
8821 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8822 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8824 !d write (2,*) 'lll=',lll
8825 !d write (2,*) 'iii=1'
8827 !d write (2,'(3(2f10.5),5x)')
8828 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8831 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8832 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8834 !d write (2,*) 'lll=',lll
8835 !d write (2,*) 'iii=2'
8837 !d write (2,'(3(2f10.5),5x)')
8838 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8844 end subroutine kernel
8845 !-----------------------------------------------------------------------------
8846 real(kind=8) function eello4(i,j,k,l,jj,kk)
8847 ! implicit real*8 (a-h,o-z)
8848 ! include 'DIMENSIONS'
8849 ! include 'COMMON.IOUNITS'
8850 ! include 'COMMON.CHAIN'
8851 ! include 'COMMON.DERIV'
8852 ! include 'COMMON.INTERACT'
8853 ! include 'COMMON.CONTACTS'
8854 ! include 'COMMON.TORSION'
8855 ! include 'COMMON.VAR'
8856 ! include 'COMMON.GEO'
8857 real(kind=8),dimension(2,2) :: pizda
8858 real(kind=8),dimension(3) :: ggg1,ggg2
8859 real(kind=8) :: eel4,glongij,glongkl
8860 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8861 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8865 !d print *,'eello4:',i,j,k,l,jj,kk
8866 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8867 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8868 !old eij=facont_hb(jj,i)
8869 !old ekl=facont_hb(kk,k)
8871 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8872 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8873 gcorr_loc(k-1)=gcorr_loc(k-1) &
8874 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8876 gcorr_loc(l-1)=gcorr_loc(l-1) &
8877 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8879 gcorr_loc(j-1)=gcorr_loc(j-1) &
8880 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8885 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8886 -EAEAderx(2,2,lll,kkk,iii,1)
8887 !d derx(lll,kkk,iii)=0.0d0
8891 !d gcorr_loc(l-1)=0.0d0
8892 !d gcorr_loc(j-1)=0.0d0
8893 !d gcorr_loc(k-1)=0.0d0
8895 !d write (iout,*)'Contacts have occurred for peptide groups',
8896 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8897 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8898 if (j.lt.nres-1) then
8905 if (l.lt.nres-1) then
8913 !grad ggg1(ll)=eel4*g_contij(ll,1)
8914 !grad ggg2(ll)=eel4*g_contij(ll,2)
8915 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8916 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8917 !grad ghalf=0.5d0*ggg1(ll)
8918 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8919 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8920 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8921 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8922 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8923 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8924 !grad ghalf=0.5d0*ggg2(ll)
8925 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8926 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8927 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8928 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8929 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8930 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8934 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8939 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8944 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8949 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8953 !d write (2,*) iii,gcorr_loc(iii)
8956 !d write (2,*) 'ekont',ekont
8957 !d write (iout,*) 'eello4',ekont*eel4
8960 !-----------------------------------------------------------------------------
8961 real(kind=8) function eello5(i,j,k,l,jj,kk)
8962 ! implicit real*8 (a-h,o-z)
8963 ! include 'DIMENSIONS'
8964 ! include 'COMMON.IOUNITS'
8965 ! include 'COMMON.CHAIN'
8966 ! include 'COMMON.DERIV'
8967 ! include 'COMMON.INTERACT'
8968 ! include 'COMMON.CONTACTS'
8969 ! include 'COMMON.TORSION'
8970 ! include 'COMMON.VAR'
8971 ! include 'COMMON.GEO'
8972 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8973 real(kind=8),dimension(2) :: vv
8974 real(kind=8),dimension(3) :: ggg1,ggg2
8975 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8976 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8977 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8978 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8983 ! /l\ / \ \ / \ / \ / C
8984 ! / \ / \ \ / \ / \ / C
8985 ! j| o |l1 | o | o| o | | o |o C
8986 ! \ |/k\| |/ \| / |/ \| |/ \| C
8987 ! \i/ \ / \ / / \ / \ C
8989 ! (I) (II) (III) (IV) C
8991 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8993 ! Antiparallel chains C
8996 ! /j\ / \ \ / \ / \ / C
8997 ! / \ / \ \ / \ / \ / C
8998 ! j1| o |l | o | o| o | | o |o C
8999 ! \ |/k\| |/ \| / |/ \| |/ \| C
9000 ! \i/ \ / \ / / \ / \ C
9002 ! (I) (II) (III) (IV) C
9004 ! eello5_1 eello5_2 eello5_3 eello5_4 C
9006 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
9008 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9009 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9014 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9016 itk=itortyp(itype(k,1))
9017 itl=itortyp(itype(l,1))
9018 itj=itortyp(itype(j,1))
9023 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9024 !d & eel5_3_num,eel5_4_num)
9028 derx(lll,kkk,iii)=0.0d0
9032 !d eij=facont_hb(jj,i)
9033 !d ekl=facont_hb(kk,k)
9035 !d write (iout,*)'Contacts have occurred for peptide groups',
9036 !d & i,j,' fcont:',eij,' eij',' and ',k,l
9038 ! Contribution from the graph I.
9039 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9040 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9041 call transpose2(EUg(1,1,k),auxmat(1,1))
9042 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9043 vv(1)=pizda(1,1)-pizda(2,2)
9044 vv(2)=pizda(1,2)+pizda(2,1)
9045 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
9046 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9047 ! Explicit gradient in virtual-dihedral angles.
9048 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
9049 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
9050 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9051 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9052 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9053 vv(1)=pizda(1,1)-pizda(2,2)
9054 vv(2)=pizda(1,2)+pizda(2,1)
9055 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9056 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
9057 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9058 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9059 vv(1)=pizda(1,1)-pizda(2,2)
9060 vv(2)=pizda(1,2)+pizda(2,1)
9062 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9063 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
9064 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9066 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9067 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
9068 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9070 ! Cartesian gradient
9074 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9076 vv(1)=pizda(1,1)-pizda(2,2)
9077 vv(2)=pizda(1,2)+pizda(2,1)
9078 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9079 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
9080 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9086 ! Contribution from graph II
9087 call transpose2(EE(1,1,itk),auxmat(1,1))
9088 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9089 vv(1)=pizda(1,1)+pizda(2,2)
9090 vv(2)=pizda(2,1)-pizda(1,2)
9091 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
9092 -0.5d0*scalar2(vv(1),Ctobr(1,k))
9093 ! Explicit gradient in virtual-dihedral angles.
9094 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9095 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9096 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9097 vv(1)=pizda(1,1)+pizda(2,2)
9098 vv(2)=pizda(2,1)-pizda(1,2)
9100 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9101 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
9102 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9104 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9105 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
9106 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9108 ! Cartesian gradient
9112 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
9114 vv(1)=pizda(1,1)+pizda(2,2)
9115 vv(2)=pizda(2,1)-pizda(1,2)
9116 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9117 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
9118 -0.5d0*scalar2(vv(1),Ctobr(1,k))
9126 ! Parallel orientation
9127 ! Contribution from graph III
9128 call transpose2(EUg(1,1,l),auxmat(1,1))
9129 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9130 vv(1)=pizda(1,1)-pizda(2,2)
9131 vv(2)=pizda(1,2)+pizda(2,1)
9132 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
9133 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9134 ! Explicit gradient in virtual-dihedral angles.
9135 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9136 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
9137 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9138 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9139 vv(1)=pizda(1,1)-pizda(2,2)
9140 vv(2)=pizda(1,2)+pizda(2,1)
9141 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9142 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
9143 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9144 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9145 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9146 vv(1)=pizda(1,1)-pizda(2,2)
9147 vv(2)=pizda(1,2)+pizda(2,1)
9148 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9149 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
9150 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9151 ! Cartesian gradient
9155 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9157 vv(1)=pizda(1,1)-pizda(2,2)
9158 vv(2)=pizda(1,2)+pizda(2,1)
9159 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9160 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
9161 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9166 ! Contribution from graph IV
9168 call transpose2(EE(1,1,itl),auxmat(1,1))
9169 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9170 vv(1)=pizda(1,1)+pizda(2,2)
9171 vv(2)=pizda(2,1)-pizda(1,2)
9172 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
9173 -0.5d0*scalar2(vv(1),Ctobr(1,l))
9174 ! Explicit gradient in virtual-dihedral angles.
9175 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9176 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9177 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9178 vv(1)=pizda(1,1)+pizda(2,2)
9179 vv(2)=pizda(2,1)-pizda(1,2)
9180 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9181 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
9182 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9183 ! Cartesian gradient
9187 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9189 vv(1)=pizda(1,1)+pizda(2,2)
9190 vv(2)=pizda(2,1)-pizda(1,2)
9191 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9192 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
9193 -0.5d0*scalar2(vv(1),Ctobr(1,l))
9198 ! Antiparallel orientation
9199 ! Contribution from graph III
9201 call transpose2(EUg(1,1,j),auxmat(1,1))
9202 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9203 vv(1)=pizda(1,1)-pizda(2,2)
9204 vv(2)=pizda(1,2)+pizda(2,1)
9205 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
9206 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9207 ! Explicit gradient in virtual-dihedral angles.
9208 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9209 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
9210 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9211 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9212 vv(1)=pizda(1,1)-pizda(2,2)
9213 vv(2)=pizda(1,2)+pizda(2,1)
9214 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9215 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
9216 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9217 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9218 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9219 vv(1)=pizda(1,1)-pizda(2,2)
9220 vv(2)=pizda(1,2)+pizda(2,1)
9221 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9222 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
9223 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9224 ! Cartesian gradient
9228 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9230 vv(1)=pizda(1,1)-pizda(2,2)
9231 vv(2)=pizda(1,2)+pizda(2,1)
9232 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9233 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
9234 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9239 ! Contribution from graph IV
9241 call transpose2(EE(1,1,itj),auxmat(1,1))
9242 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9243 vv(1)=pizda(1,1)+pizda(2,2)
9244 vv(2)=pizda(2,1)-pizda(1,2)
9245 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
9246 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9247 ! Explicit gradient in virtual-dihedral angles.
9248 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9249 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9250 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9251 vv(1)=pizda(1,1)+pizda(2,2)
9252 vv(2)=pizda(2,1)-pizda(1,2)
9253 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9254 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
9255 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9256 ! Cartesian gradient
9260 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9262 vv(1)=pizda(1,1)+pizda(2,2)
9263 vv(2)=pizda(2,1)-pizda(1,2)
9264 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9265 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
9266 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9272 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9273 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9274 !d write (2,*) 'ijkl',i,j,k,l
9275 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9276 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
9278 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9279 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9280 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9281 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9282 if (j.lt.nres-1) then
9289 if (l.lt.nres-1) then
9299 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9300 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
9301 ! summed up outside the subrouine as for the other subroutines
9302 ! handling long-range interactions. The old code is commented out
9303 ! with "cgrad" to keep track of changes.
9305 !grad ggg1(ll)=eel5*g_contij(ll,1)
9306 !grad ggg2(ll)=eel5*g_contij(ll,2)
9307 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9308 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9309 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9310 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9311 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9312 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9313 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9314 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9316 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9317 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9318 !grad ghalf=0.5d0*ggg1(ll)
9320 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9321 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9322 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9323 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9324 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9325 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9326 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9327 !grad ghalf=0.5d0*ggg2(ll)
9329 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9330 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9331 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9332 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9333 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9334 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9339 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9340 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9345 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9346 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9352 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9357 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9361 !d write (2,*) iii,g_corr5_loc(iii)
9364 !d write (2,*) 'ekont',ekont
9365 !d write (iout,*) 'eello5',ekont*eel5
9368 !-----------------------------------------------------------------------------
9369 real(kind=8) function eello6(i,j,k,l,jj,kk)
9370 ! implicit real*8 (a-h,o-z)
9371 ! include 'DIMENSIONS'
9372 ! include 'COMMON.IOUNITS'
9373 ! include 'COMMON.CHAIN'
9374 ! include 'COMMON.DERIV'
9375 ! include 'COMMON.INTERACT'
9376 ! include 'COMMON.CONTACTS'
9377 ! include 'COMMON.TORSION'
9378 ! include 'COMMON.VAR'
9379 ! include 'COMMON.GEO'
9380 ! include 'COMMON.FFIELD'
9381 real(kind=8),dimension(3) :: ggg1,ggg2
9382 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
9384 real(kind=8) :: gradcorr6ij,gradcorr6kl
9385 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9386 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9391 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9399 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9400 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9404 derx(lll,kkk,iii)=0.0d0
9408 !d eij=facont_hb(jj,i)
9409 !d ekl=facont_hb(kk,k)
9415 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9416 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9417 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9418 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9419 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9420 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9422 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9423 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9424 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9425 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9426 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9427 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9431 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9433 ! If turn contributions are considered, they will be handled separately.
9434 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9435 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9436 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9437 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9438 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9439 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9440 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9442 if (j.lt.nres-1) then
9449 if (l.lt.nres-1) then
9457 !grad ggg1(ll)=eel6*g_contij(ll,1)
9458 !grad ggg2(ll)=eel6*g_contij(ll,2)
9459 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9460 !grad ghalf=0.5d0*ggg1(ll)
9462 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9463 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9464 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9465 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9466 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9467 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9468 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9469 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9470 !grad ghalf=0.5d0*ggg2(ll)
9471 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9473 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9474 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9475 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9476 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9477 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9478 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9483 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9484 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9489 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9490 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9496 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9501 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9505 !d write (2,*) iii,g_corr6_loc(iii)
9508 !d write (2,*) 'ekont',ekont
9509 !d write (iout,*) 'eello6',ekont*eel6
9512 !-----------------------------------------------------------------------------
9513 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
9515 ! implicit real*8 (a-h,o-z)
9516 ! include 'DIMENSIONS'
9517 ! include 'COMMON.IOUNITS'
9518 ! include 'COMMON.CHAIN'
9519 ! include 'COMMON.DERIV'
9520 ! include 'COMMON.INTERACT'
9521 ! include 'COMMON.CONTACTS'
9522 ! include 'COMMON.TORSION'
9523 ! include 'COMMON.VAR'
9524 ! include 'COMMON.GEO'
9525 real(kind=8),dimension(2) :: vv,vv1
9526 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
9529 !el common /kutas/ lprn
9530 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
9531 real(kind=8) :: s1,s2,s3,s4,s5
9532 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9534 ! Parallel Antiparallel C
9540 ! \ j|/k\| / \ |/k\|l / C
9545 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9546 itk=itortyp(itype(k,1))
9547 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9548 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9549 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9550 call transpose2(EUgC(1,1,k),auxmat(1,1))
9551 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9552 vv1(1)=pizda1(1,1)-pizda1(2,2)
9553 vv1(2)=pizda1(1,2)+pizda1(2,1)
9554 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9555 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9556 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9557 s5=scalar2(vv(1),Dtobr2(1,i))
9558 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9559 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9560 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
9561 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
9562 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
9563 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
9564 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
9565 +scalar2(vv(1),Dtobr2der(1,i)))
9566 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9567 vv1(1)=pizda1(1,1)-pizda1(2,2)
9568 vv1(2)=pizda1(1,2)+pizda1(2,1)
9569 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9570 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9572 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
9573 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9574 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9575 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9576 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9578 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
9579 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9580 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9581 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9582 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9584 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9585 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9586 vv1(1)=pizda1(1,1)-pizda1(2,2)
9587 vv1(2)=pizda1(1,2)+pizda1(2,1)
9588 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
9589 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
9590 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
9591 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9600 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9601 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9602 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9603 call transpose2(EUgC(1,1,k),auxmat(1,1))
9604 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9606 vv1(1)=pizda1(1,1)-pizda1(2,2)
9607 vv1(2)=pizda1(1,2)+pizda1(2,1)
9608 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9609 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
9610 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9611 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
9612 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9613 s5=scalar2(vv(1),Dtobr2(1,i))
9614 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9619 end function eello6_graph1
9620 !-----------------------------------------------------------------------------
9621 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9623 ! implicit real*8 (a-h,o-z)
9624 ! include 'DIMENSIONS'
9625 ! include 'COMMON.IOUNITS'
9626 ! include 'COMMON.CHAIN'
9627 ! include 'COMMON.DERIV'
9628 ! include 'COMMON.INTERACT'
9629 ! include 'COMMON.CONTACTS'
9630 ! include 'COMMON.TORSION'
9631 ! include 'COMMON.VAR'
9632 ! include 'COMMON.GEO'
9634 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9635 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9637 !el common /kutas/ lprn
9638 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9639 real(kind=8) :: s2,s3,s4
9640 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9642 ! Parallel Antiparallel C
9648 ! \ j|/k\| \ |/k\|l C
9653 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9654 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9655 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9656 ! but not in a cluster cumulant
9658 s1=dip(1,jj,i)*dip(1,kk,k)
9660 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9661 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9662 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9663 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9664 call transpose2(EUg(1,1,k),auxmat(1,1))
9665 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9666 vv(1)=pizda(1,1)-pizda(2,2)
9667 vv(2)=pizda(1,2)+pizda(2,1)
9668 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9669 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9671 eello6_graph2=-(s1+s2+s3+s4)
9673 eello6_graph2=-(s2+s3+s4)
9676 ! Derivatives in gamma(i-1)
9679 s1=dipderg(1,jj,i)*dip(1,kk,k)
9681 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9682 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9683 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9684 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9686 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9688 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9690 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9692 ! Derivatives in gamma(k-1)
9694 s1=dip(1,jj,i)*dipderg(1,kk,k)
9696 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9697 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9698 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9699 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9700 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9701 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9702 vv(1)=pizda(1,1)-pizda(2,2)
9703 vv(2)=pizda(1,2)+pizda(2,1)
9704 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9706 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9708 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9710 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9711 ! Derivatives in gamma(j-1) or gamma(l-1)
9714 s1=dipderg(3,jj,i)*dip(1,kk,k)
9716 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9717 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9718 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9719 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9720 vv(1)=pizda(1,1)-pizda(2,2)
9721 vv(2)=pizda(1,2)+pizda(2,1)
9722 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9725 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9727 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9730 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9731 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9733 ! Derivatives in gamma(l-1) or gamma(j-1)
9736 s1=dip(1,jj,i)*dipderg(3,kk,k)
9738 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9739 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9740 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9741 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9742 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9743 vv(1)=pizda(1,1)-pizda(2,2)
9744 vv(2)=pizda(1,2)+pizda(2,1)
9745 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9748 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9750 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9753 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9754 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9756 ! Cartesian derivatives.
9758 write (2,*) 'In eello6_graph2'
9760 write (2,*) 'iii=',iii
9762 write (2,*) 'kkk=',kkk
9764 write (2,'(3(2f10.5),5x)') &
9765 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9775 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9777 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9780 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9782 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9783 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9785 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9786 call transpose2(EUg(1,1,k),auxmat(1,1))
9787 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9789 vv(1)=pizda(1,1)-pizda(2,2)
9790 vv(2)=pizda(1,2)+pizda(2,1)
9791 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9792 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9794 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9796 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9799 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9801 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9807 end function eello6_graph2
9808 !-----------------------------------------------------------------------------
9809 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9810 ! implicit real*8 (a-h,o-z)
9811 ! include 'DIMENSIONS'
9812 ! include 'COMMON.IOUNITS'
9813 ! include 'COMMON.CHAIN'
9814 ! include 'COMMON.DERIV'
9815 ! include 'COMMON.INTERACT'
9816 ! include 'COMMON.CONTACTS'
9817 ! include 'COMMON.TORSION'
9818 ! include 'COMMON.VAR'
9819 ! include 'COMMON.GEO'
9820 real(kind=8),dimension(2) :: vv,auxvec
9821 real(kind=8),dimension(2,2) :: pizda,auxmat
9823 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9824 real(kind=8) :: s1,s2,s3,s4
9825 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9827 ! Parallel Antiparallel C
9833 ! j|/k\| / |/k\|l / C
9838 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9840 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9841 ! energy moment and not to the cluster cumulant.
9842 iti=itortyp(itype(i,1))
9843 if (j.lt.nres-1) then
9844 itj1=itortyp(itype(j+1,1))
9848 itk=itortyp(itype(k,1))
9849 itk1=itortyp(itype(k+1,1))
9850 if (l.lt.nres-1) then
9851 itl1=itortyp(itype(l+1,1))
9856 s1=dip(4,jj,i)*dip(4,kk,k)
9858 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9859 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9860 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9861 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9862 call transpose2(EE(1,1,itk),auxmat(1,1))
9863 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9864 vv(1)=pizda(1,1)+pizda(2,2)
9865 vv(2)=pizda(2,1)-pizda(1,2)
9866 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9867 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9868 !d & "sum",-(s2+s3+s4)
9870 eello6_graph3=-(s1+s2+s3+s4)
9872 eello6_graph3=-(s2+s3+s4)
9875 ! Derivatives in gamma(k-1)
9876 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9877 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9878 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9879 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9880 ! Derivatives in gamma(l-1)
9881 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9882 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9883 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9884 vv(1)=pizda(1,1)+pizda(2,2)
9885 vv(2)=pizda(2,1)-pizda(1,2)
9886 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9887 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9888 ! Cartesian derivatives.
9894 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9896 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9899 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9901 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9902 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9904 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9905 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9907 vv(1)=pizda(1,1)+pizda(2,2)
9908 vv(2)=pizda(2,1)-pizda(1,2)
9909 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9911 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9913 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9916 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9918 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9920 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9925 end function eello6_graph3
9926 !-----------------------------------------------------------------------------
9927 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9928 ! implicit real*8 (a-h,o-z)
9929 ! include 'DIMENSIONS'
9930 ! include 'COMMON.IOUNITS'
9931 ! include 'COMMON.CHAIN'
9932 ! include 'COMMON.DERIV'
9933 ! include 'COMMON.INTERACT'
9934 ! include 'COMMON.CONTACTS'
9935 ! include 'COMMON.TORSION'
9936 ! include 'COMMON.VAR'
9937 ! include 'COMMON.GEO'
9938 ! include 'COMMON.FFIELD'
9939 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9940 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9942 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9944 real(kind=8) :: s1,s2,s3,s4
9945 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9947 ! Parallel Antiparallel C
9953 ! \ j|/k\| \ |/k\|l C
9958 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9960 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9961 ! energy moment and not to the cluster cumulant.
9962 !d write (2,*) 'eello_graph4: wturn6',wturn6
9963 iti=itortyp(itype(i,1))
9964 itj=itortyp(itype(j,1))
9965 if (j.lt.nres-1) then
9966 itj1=itortyp(itype(j+1,1))
9970 itk=itortyp(itype(k,1))
9971 if (k.lt.nres-1) then
9972 itk1=itortyp(itype(k+1,1))
9976 itl=itortyp(itype(l,1))
9977 if (l.lt.nres-1) then
9978 itl1=itortyp(itype(l+1,1))
9982 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9983 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9984 !d & ' itl',itl,' itl1',itl1
9987 s1=dip(3,jj,i)*dip(3,kk,k)
9989 s1=dip(2,jj,j)*dip(2,kk,l)
9992 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9993 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9995 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9996 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9998 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9999 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10001 call transpose2(EUg(1,1,k),auxmat(1,1))
10002 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10003 vv(1)=pizda(1,1)-pizda(2,2)
10004 vv(2)=pizda(2,1)+pizda(1,2)
10005 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10006 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10008 eello6_graph4=-(s1+s2+s3+s4)
10010 eello6_graph4=-(s2+s3+s4)
10012 ! Derivatives in gamma(i-1)
10015 if (imat.eq.1) then
10016 s1=dipderg(2,jj,i)*dip(3,kk,k)
10018 s1=dipderg(4,jj,j)*dip(2,kk,l)
10021 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10023 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
10024 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10026 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
10027 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10029 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10030 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10031 !d write (2,*) 'turn6 derivatives'
10033 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10035 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10039 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10041 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10045 ! Derivatives in gamma(k-1)
10047 if (imat.eq.1) then
10048 s1=dip(3,jj,i)*dipderg(2,kk,k)
10050 s1=dip(2,jj,j)*dipderg(4,kk,l)
10053 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10054 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10056 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
10057 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10059 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
10060 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10062 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10063 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10064 vv(1)=pizda(1,1)-pizda(2,2)
10065 vv(2)=pizda(2,1)+pizda(1,2)
10066 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10067 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10069 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10071 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10075 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10077 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10080 ! Derivatives in gamma(j-1) or gamma(l-1)
10081 if (l.eq.j+1 .and. l.gt.1) then
10082 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10083 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10084 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10085 vv(1)=pizda(1,1)-pizda(2,2)
10086 vv(2)=pizda(2,1)+pizda(1,2)
10087 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10088 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10089 else if (j.gt.1) then
10090 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10091 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10092 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10093 vv(1)=pizda(1,1)-pizda(2,2)
10094 vv(2)=pizda(2,1)+pizda(1,2)
10095 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10096 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10097 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10099 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10102 ! Cartesian derivatives.
10108 if (imat.eq.1) then
10109 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10111 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10114 if (imat.eq.1) then
10115 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10117 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10121 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
10123 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10125 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
10126 b1(1,itj1),auxvec(1))
10127 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
10129 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
10130 b1(1,itl1),auxvec(1))
10131 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
10133 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
10135 vv(1)=pizda(1,1)-pizda(2,2)
10136 vv(2)=pizda(2,1)+pizda(1,2)
10137 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10139 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10141 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
10144 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
10147 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10150 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10152 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10154 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10158 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10160 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10163 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10165 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10172 end function eello6_graph4
10173 !-----------------------------------------------------------------------------
10174 real(kind=8) function eello_turn6(i,jj,kk)
10175 ! implicit real*8 (a-h,o-z)
10176 ! include 'DIMENSIONS'
10177 ! include 'COMMON.IOUNITS'
10178 ! include 'COMMON.CHAIN'
10179 ! include 'COMMON.DERIV'
10180 ! include 'COMMON.INTERACT'
10181 ! include 'COMMON.CONTACTS'
10182 ! include 'COMMON.TORSION'
10183 ! include 'COMMON.VAR'
10184 ! include 'COMMON.GEO'
10185 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
10186 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
10187 real(kind=8),dimension(3) :: ggg1,ggg2
10188 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
10189 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
10190 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10191 ! the respective energy moment and not to the cluster cumulant.
10192 !el local variables
10193 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
10194 integer :: j1,j2,l1,l2,ll
10195 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
10196 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
10205 iti=itortyp(itype(i,1))
10206 itk=itortyp(itype(k,1))
10207 itk1=itortyp(itype(k+1,1))
10208 itl=itortyp(itype(l,1))
10209 itj=itortyp(itype(j,1))
10210 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10211 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
10212 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10217 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10219 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
10223 derx_turn(lll,kkk,iii)=0.0d0
10230 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10232 !d write (2,*) 'eello6_5',eello6_5
10234 call transpose2(AEA(1,1,1),auxmat(1,1))
10235 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10236 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
10237 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10239 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10240 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10241 s2 = scalar2(b1(1,itk),vtemp1(1))
10243 call transpose2(AEA(1,1,2),atemp(1,1))
10244 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10245 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10246 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10248 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10249 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10250 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10252 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10253 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10254 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10255 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10256 ss13 = scalar2(b1(1,itk),vtemp4(1))
10257 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10259 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10265 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10266 ! Derivatives in gamma(i+2)
10270 call transpose2(AEA(1,1,1),auxmatd(1,1))
10271 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10272 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10273 call transpose2(AEAderg(1,1,2),atempd(1,1))
10274 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10275 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10277 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10278 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10279 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10285 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10286 ! Derivatives in gamma(i+3)
10288 call transpose2(AEA(1,1,1),auxmatd(1,1))
10289 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10290 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
10291 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10293 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
10294 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10295 s2d = scalar2(b1(1,itk),vtemp1d(1))
10297 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10298 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10300 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10302 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10303 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10304 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10312 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10313 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10315 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10316 -0.5d0*ekont*(s2d+s12d)
10318 ! Derivatives in gamma(i+4)
10319 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10320 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10321 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10323 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10324 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10325 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10333 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10335 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10337 ! Derivatives in gamma(i+5)
10339 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10340 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10341 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10343 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
10344 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10345 s2d = scalar2(b1(1,itk),vtemp1d(1))
10347 call transpose2(AEA(1,1,2),atempd(1,1))
10348 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10349 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10351 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10352 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10354 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10355 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10356 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10364 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10365 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10367 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10368 -0.5d0*ekont*(s2d+s12d)
10370 ! Cartesian derivatives
10375 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10376 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10377 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10379 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10380 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
10382 s2d = scalar2(b1(1,itk),vtemp1d(1))
10384 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10385 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10386 s8d = -(atempd(1,1)+atempd(2,2))* &
10387 scalar2(cc(1,1,itl),vtemp2(1))
10389 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
10391 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10392 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10399 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10402 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10406 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10409 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10418 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
10420 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10421 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10422 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10423 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10424 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
10426 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10427 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10428 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10432 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10433 !d & 16*eel_turn6_num
10435 if (j.lt.nres-1) then
10442 if (l.lt.nres-1) then
10450 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
10451 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
10452 !grad ghalf=0.5d0*ggg1(ll)
10454 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10455 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10456 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
10457 +ekont*derx_turn(ll,2,1)
10458 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10459 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
10460 +ekont*derx_turn(ll,4,1)
10461 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10462 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10463 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10464 !grad ghalf=0.5d0*ggg2(ll)
10466 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
10467 +ekont*derx_turn(ll,2,2)
10468 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10469 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
10470 +ekont*derx_turn(ll,4,2)
10471 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10472 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10473 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10478 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10483 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10489 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10494 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10498 !d write (2,*) iii,g_corr6_loc(iii)
10500 eello_turn6=ekont*eel_turn6
10501 !d write (2,*) 'ekont',ekont
10502 !d write (2,*) 'eel_turn6',ekont*eel_turn6
10504 end function eello_turn6
10505 !-----------------------------------------------------------------------------
10506 subroutine MATVEC2(A1,V1,V2)
10507 !DIR$ INLINEALWAYS MATVEC2
10509 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10511 ! implicit real*8 (a-h,o-z)
10512 ! include 'DIMENSIONS'
10513 real(kind=8),dimension(2) :: V1,V2
10514 real(kind=8),dimension(2,2) :: A1
10515 real(kind=8) :: vaux1,vaux2
10519 ! 3 VI=VI+A1(I,K)*V1(K)
10523 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10524 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10528 end subroutine MATVEC2
10529 !-----------------------------------------------------------------------------
10530 subroutine MATMAT2(A1,A2,A3)
10532 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10534 ! implicit real*8 (a-h,o-z)
10535 ! include 'DIMENSIONS'
10536 real(kind=8),dimension(2,2) :: A1,A2,A3
10537 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
10538 ! DIMENSION AI3(2,2)
10542 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
10548 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10549 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10550 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10551 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10557 end subroutine MATMAT2
10558 !-----------------------------------------------------------------------------
10559 real(kind=8) function scalar2(u,v)
10560 !DIR$ INLINEALWAYS scalar2
10562 real(kind=8),dimension(2) :: u,v
10565 scalar2=u(1)*v(1)+u(2)*v(2)
10567 end function scalar2
10568 !-----------------------------------------------------------------------------
10569 subroutine transpose2(a,at)
10570 !DIR$ INLINEALWAYS transpose2
10572 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
10575 real(kind=8),dimension(2,2) :: a,at
10581 end subroutine transpose2
10582 !-----------------------------------------------------------------------------
10583 subroutine transpose(n,a,at)
10586 real(kind=8),dimension(n,n) :: a,at
10593 end subroutine transpose
10594 !-----------------------------------------------------------------------------
10595 subroutine prodmat3(a1,a2,kk,transp,prod)
10596 !DIR$ INLINEALWAYS prodmat3
10598 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
10602 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
10604 !rc double precision auxmat(2,2),prod_(2,2)
10607 !rc call transpose2(kk(1,1),auxmat(1,1))
10608 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10609 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10611 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
10612 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10613 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
10614 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10615 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
10616 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10617 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10618 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10621 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10622 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10624 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10625 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10626 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10627 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10628 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10629 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10630 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10631 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10634 ! call transpose2(a2(1,1),a2t(1,1))
10637 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10638 !rc print *,((prod(i,j),i=1,2),j=1,2)
10641 end subroutine prodmat3
10642 !-----------------------------------------------------------------------------
10643 ! energy_p_new_barrier.F
10644 !-----------------------------------------------------------------------------
10645 subroutine sum_gradient
10646 ! implicit real*8 (a-h,o-z)
10647 use io_base, only: pdbout
10648 ! include 'DIMENSIONS'
10652 !MS$ATTRIBUTES C :: proc_proc
10658 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10659 gloc_scbuf !(3,maxres)
10661 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10663 !el local variables
10664 integer :: i,j,k,ierror,ierr
10665 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10666 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10667 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10668 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10669 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10670 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10671 gsccorr_max,gsccorrx_max,time00
10673 ! include 'COMMON.SETUP'
10674 ! include 'COMMON.IOUNITS'
10675 ! include 'COMMON.FFIELD'
10676 ! include 'COMMON.DERIV'
10677 ! include 'COMMON.INTERACT'
10678 ! include 'COMMON.SBRIDGE'
10679 ! include 'COMMON.CHAIN'
10680 ! include 'COMMON.VAR'
10681 ! include 'COMMON.CONTROL'
10682 ! include 'COMMON.TIME1'
10683 ! include 'COMMON.MAXGRAD'
10684 ! include 'COMMON.SCCOR'
10689 write (iout,*) "sum_gradient gvdwc, gvdwx"
10691 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10692 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10702 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10703 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10704 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10707 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10708 ! in virtual-bond-vector coordinates
10711 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10713 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10714 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10716 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10718 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10719 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10721 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10723 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10724 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10725 (gvdwc_scpp(j,i),j=1,3)
10727 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10729 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10730 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10731 (gelc_loc_long(j,i),j=1,3)
10738 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10739 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10740 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10741 wel_loc*gel_loc_long(j,i)+ &
10742 wcorr*gradcorr_long(j,i)+ &
10743 wcorr5*gradcorr5_long(j,i)+ &
10744 wcorr6*gradcorr6_long(j,i)+ &
10745 wturn6*gcorr6_turn_long(j,i)+ &
10746 wstrain*ghpbc(j,i) &
10747 +wliptran*gliptranc(j,i) &
10749 +welec*gshieldc(j,i) &
10750 +wcorr*gshieldc_ec(j,i) &
10751 +wturn3*gshieldc_t3(j,i)&
10752 +wturn4*gshieldc_t4(j,i)&
10753 +wel_loc*gshieldc_ll(j,i)&
10754 +wtube*gg_tube(j,i) &
10755 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10756 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10757 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10758 wcorr_nucl*gradcorr_nucl(j,i)&
10759 +wcorr3_nucl*gradcorr3_nucl(j,i)+&
10760 wcatprot* gradpepcat(j,i)+ &
10761 wcatcat*gradcatcat(j,i)+ &
10762 wscbase*gvdwc_scbase(j,i)+ &
10763 wpepbase*gvdwc_pepbase(j,i)+&
10764 wscpho*gvdwc_scpho(j,i)+ &
10765 wpeppho*gvdwc_peppho(j,i)
10776 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10777 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10778 welec*gelc_long(j,i)+ &
10779 wbond*gradb(j,i)+ &
10780 wel_loc*gel_loc_long(j,i)+ &
10781 wcorr*gradcorr_long(j,i)+ &
10782 wcorr5*gradcorr5_long(j,i)+ &
10783 wcorr6*gradcorr6_long(j,i)+ &
10784 wturn6*gcorr6_turn_long(j,i)+ &
10785 wstrain*ghpbc(j,i) &
10786 +wliptran*gliptranc(j,i) &
10788 +welec*gshieldc(j,i)&
10789 +wcorr*gshieldc_ec(j,i) &
10790 +wturn4*gshieldc_t4(j,i) &
10791 +wel_loc*gshieldc_ll(j,i)&
10792 +wtube*gg_tube(j,i) &
10793 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10794 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10795 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10796 wcorr_nucl*gradcorr_nucl(j,i) &
10797 +wcorr3_nucl*gradcorr3_nucl(j,i) +&
10798 wcatprot* gradpepcat(j,i)+ &
10799 wcatcat*gradcatcat(j,i)+ &
10800 wscbase*gvdwc_scbase(j,i) &
10801 wpepbase*gvdwc_pepbase(j,i)+&
10802 wscpho*gvdwc_scpho(j,i)+&
10803 wpeppho*gvdwc_peppho(j,i)
10810 if (nfgtasks.gt.1) then
10813 write (iout,*) "gradbufc before allreduce"
10815 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10821 gradbufc_sum(j,i)=gradbufc(j,i)
10824 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10825 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10826 ! time_reduce=time_reduce+MPI_Wtime()-time00
10828 ! write (iout,*) "gradbufc_sum after allreduce"
10830 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10835 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10839 gradbufc(k,i)=0.0d0
10843 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10844 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10845 " jgrad_end ",jgrad_end(i),&
10846 i=igrad_start,igrad_end)
10849 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10850 ! do not parallelize this part.
10852 ! do i=igrad_start,igrad_end
10853 ! do j=jgrad_start(i),jgrad_end(i)
10855 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10860 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10864 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10868 write (iout,*) "gradbufc after summing"
10870 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10878 write (iout,*) "gradbufc"
10880 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10887 gradbufc_sum(j,i)=gradbufc(j,i)
10888 gradbufc(j,i)=0.0d0
10892 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10896 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10901 ! gradbufc(k,i)=0.0d0
10905 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10911 write (iout,*) "gradbufc after summing"
10913 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10922 gradbufc(k,nres)=0.0d0
10924 !el----------------
10925 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10926 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10927 !el-----------------
10931 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10932 wel_loc*gel_loc(j,i)+ &
10933 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10934 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10935 wel_loc*gel_loc_long(j,i)+ &
10936 wcorr*gradcorr_long(j,i)+ &
10937 wcorr5*gradcorr5_long(j,i)+ &
10938 wcorr6*gradcorr6_long(j,i)+ &
10939 wturn6*gcorr6_turn_long(j,i))+ &
10940 wbond*gradb(j,i)+ &
10941 wcorr*gradcorr(j,i)+ &
10942 wturn3*gcorr3_turn(j,i)+ &
10943 wturn4*gcorr4_turn(j,i)+ &
10944 wcorr5*gradcorr5(j,i)+ &
10945 wcorr6*gradcorr6(j,i)+ &
10946 wturn6*gcorr6_turn(j,i)+ &
10947 wsccor*gsccorc(j,i) &
10948 +wscloc*gscloc(j,i) &
10949 +wliptran*gliptranc(j,i) &
10951 +welec*gshieldc(j,i) &
10952 +welec*gshieldc_loc(j,i) &
10953 +wcorr*gshieldc_ec(j,i) &
10954 +wcorr*gshieldc_loc_ec(j,i) &
10955 +wturn3*gshieldc_t3(j,i) &
10956 +wturn3*gshieldc_loc_t3(j,i) &
10957 +wturn4*gshieldc_t4(j,i) &
10958 +wturn4*gshieldc_loc_t4(j,i) &
10959 +wel_loc*gshieldc_ll(j,i) &
10960 +wel_loc*gshieldc_loc_ll(j,i) &
10961 +wtube*gg_tube(j,i) &
10962 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10963 +wvdwpsb*gvdwpsb1(j,i))&
10964 +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
10965 ! if (i.eq.21) then
10966 ! print *,"in sum",gradc(j,i,icg),wturn4*gcorr4_turn(j,i),&
10967 ! wturn4*gshieldc_t4(j,i), &
10968 ! wturn4*gshieldc_loc_t4(j,i)
10970 ! if ((i.le.2).and.(i.ge.1))
10971 ! print *,gradc(j,i,icg),&
10972 ! gradbufc(j,i),welec*gelc(j,i), &
10973 ! wel_loc*gel_loc(j,i), &
10974 ! wscp*gvdwc_scpp(j,i), &
10975 ! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
10976 ! wel_loc*gel_loc_long(j,i), &
10977 ! wcorr*gradcorr_long(j,i), &
10978 ! wcorr5*gradcorr5_long(j,i), &
10979 ! wcorr6*gradcorr6_long(j,i), &
10980 ! wturn6*gcorr6_turn_long(j,i), &
10981 ! wbond*gradb(j,i), &
10982 ! wcorr*gradcorr(j,i), &
10983 ! wturn3*gcorr3_turn(j,i), &
10984 ! wturn4*gcorr4_turn(j,i), &
10985 ! wcorr5*gradcorr5(j,i), &
10986 ! wcorr6*gradcorr6(j,i), &
10987 ! wturn6*gcorr6_turn(j,i), &
10988 ! wsccor*gsccorc(j,i) &
10989 ! ,wscloc*gscloc(j,i) &
10990 ! ,wliptran*gliptranc(j,i) &
10992 ! ,welec*gshieldc(j,i) &
10993 ! ,welec*gshieldc_loc(j,i) &
10994 ! ,wcorr*gshieldc_ec(j,i) &
10995 ! ,wcorr*gshieldc_loc_ec(j,i) &
10996 ! ,wturn3*gshieldc_t3(j,i) &
10997 ! ,wturn3*gshieldc_loc_t3(j,i) &
10998 ! ,wturn4*gshieldc_t4(j,i) &
10999 ! ,wturn4*gshieldc_loc_t4(j,i) &
11000 ! ,wel_loc*gshieldc_ll(j,i) &
11001 ! ,wel_loc*gshieldc_loc_ll(j,i) &
11002 ! ,wtube*gg_tube(j,i) &
11003 ! ,wbond_nucl*gradb_nucl(j,i) &
11004 ! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
11005 ! wvdwpsb*gvdwpsb1(j,i)&
11006 ! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
11010 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
11011 wel_loc*gel_loc(j,i)+ &
11012 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
11013 welec*gelc_long(j,i)+ &
11014 wel_loc*gel_loc_long(j,i)+ &
11015 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
11016 wcorr5*gradcorr5_long(j,i)+ &
11017 wcorr6*gradcorr6_long(j,i)+ &
11018 wturn6*gcorr6_turn_long(j,i))+ &
11019 wbond*gradb(j,i)+ &
11020 wcorr*gradcorr(j,i)+ &
11021 wturn3*gcorr3_turn(j,i)+ &
11022 wturn4*gcorr4_turn(j,i)+ &
11023 wcorr5*gradcorr5(j,i)+ &
11024 wcorr6*gradcorr6(j,i)+ &
11025 wturn6*gcorr6_turn(j,i)+ &
11026 wsccor*gsccorc(j,i) &
11027 +wscloc*gscloc(j,i) &
11029 +wliptran*gliptranc(j,i) &
11030 +welec*gshieldc(j,i) &
11031 +welec*gshieldc_loc(j,) &
11032 +wcorr*gshieldc_ec(j,i) &
11033 +wcorr*gshieldc_loc_ec(j,i) &
11034 +wturn3*gshieldc_t3(j,i) &
11035 +wturn3*gshieldc_loc_t3(j,i) &
11036 +wturn4*gshieldc_t4(j,i) &
11037 +wturn4*gshieldc_loc_t4(j,i) &
11038 +wel_loc*gshieldc_ll(j,i) &
11039 +wel_loc*gshieldc_loc_ll(j,i) &
11040 +wtube*gg_tube(j,i) &
11041 +wbond_nucl*gradb_nucl(j,i) &
11042 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
11043 +wvdwpsb*gvdwpsb1(j,i))&
11044 +wsbloc*gsbloc(j,i)
11050 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
11051 wbond*gradbx(j,i)+ &
11052 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
11053 wsccor*gsccorx(j,i) &
11054 +wscloc*gsclocx(j,i) &
11055 +wliptran*gliptranx(j,i) &
11056 +welec*gshieldx(j,i) &
11057 +wcorr*gshieldx_ec(j,i) &
11058 +wturn3*gshieldx_t3(j,i) &
11059 +wturn4*gshieldx_t4(j,i) &
11060 +wel_loc*gshieldx_ll(j,i)&
11061 +wtube*gg_tube_sc(j,i) &
11062 +wbond_nucl*gradbx_nucl(j,i) &
11063 +wvdwsb*gvdwsbx(j,i) &
11064 +welsb*gelsbx(j,i) &
11065 +wcorr_nucl*gradxorr_nucl(j,i)&
11066 +wcorr3_nucl*gradxorr3_nucl(j,i) &
11067 +wsbloc*gsblocx(j,i) &
11068 +wcatprot* gradpepcatx(j,i)&
11069 +wscbase*gvdwx_scbase(j,i) &
11070 +wpepbase*gvdwx_pepbase(j,i)&
11071 +wscpho*gvdwx_scpho(j,i)
11072 ! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
11078 write (iout,*) "gloc before adding corr"
11080 write (iout,*) i,gloc(i,icg)
11084 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
11085 +wcorr5*g_corr5_loc(i) &
11086 +wcorr6*g_corr6_loc(i) &
11087 +wturn4*gel_loc_turn4(i) &
11088 +wturn3*gel_loc_turn3(i) &
11089 +wturn6*gel_loc_turn6(i) &
11090 +wel_loc*gel_loc_loc(i)
11093 write (iout,*) "gloc after adding corr"
11095 write (iout,*) i,gloc(i,icg)
11100 if (nfgtasks.gt.1) then
11103 gradbufc(j,i)=gradc(j,i,icg)
11104 gradbufx(j,i)=gradx(j,i,icg)
11108 glocbuf(i)=gloc(i,icg)
11112 write (iout,*) "gloc_sc before reduce"
11115 write (iout,*) i,j,gloc_sc(j,i,icg)
11122 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
11126 call MPI_Barrier(FG_COMM,IERR)
11127 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
11129 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
11130 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11131 call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
11132 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11133 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
11134 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11135 time_reduce=time_reduce+MPI_Wtime()-time00
11136 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
11137 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11138 time_reduce=time_reduce+MPI_Wtime()-time00
11140 ! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
11142 write (iout,*) "gloc_sc after reduce"
11145 write (iout,*) i,j,gloc_sc(j,i,icg)
11151 write (iout,*) "gloc after reduce"
11153 write (iout,*) i,gloc(i,icg)
11158 if (gnorm_check) then
11160 ! Compute the maximum elements of the gradient
11163 gvdwc_scp_max=0.0d0
11170 gcorr3_turn_max=0.0d0
11171 gcorr4_turn_max=0.0d0
11172 gradcorr5_max=0.0d0
11173 gradcorr6_max=0.0d0
11174 gcorr6_turn_max=0.0d0
11178 gradx_scp_max=0.0d0
11184 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
11185 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
11186 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
11187 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
11188 gvdwc_scp_max=gvdwc_scp_norm
11189 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
11190 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
11191 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
11192 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
11193 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
11194 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
11195 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
11196 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
11197 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
11198 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
11199 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
11200 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
11201 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
11203 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
11204 gcorr3_turn_max=gcorr3_turn_norm
11205 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
11207 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
11208 gcorr4_turn_max=gcorr4_turn_norm
11209 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
11210 if (gradcorr5_norm.gt.gradcorr5_max) &
11211 gradcorr5_max=gradcorr5_norm
11212 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
11213 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
11214 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
11216 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
11217 gcorr6_turn_max=gcorr6_turn_norm
11218 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
11219 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
11220 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
11221 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
11222 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
11223 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
11224 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
11225 if (gradx_scp_norm.gt.gradx_scp_max) &
11226 gradx_scp_max=gradx_scp_norm
11227 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
11228 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
11229 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
11230 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
11231 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
11232 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
11233 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
11234 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
11238 open(istat,file=statname,position="append")
11240 open(istat,file=statname,access="append")
11242 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
11243 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
11244 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
11245 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
11246 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
11247 gsccorx_max,gsclocx_max
11249 if (gvdwc_max.gt.1.0d4) then
11250 write (iout,*) "gvdwc gvdwx gradb gradbx"
11252 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
11253 gradb(j,i),gradbx(j,i),j=1,3)
11255 call pdbout(0.0d0,'cipiszcze',iout)
11262 write (iout,*) "gradc gradx gloc"
11264 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
11265 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
11270 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
11273 end subroutine sum_gradient
11274 !-----------------------------------------------------------------------------
11276 ! implicit real*8 (a-h,o-z)
11278 ! include 'DIMENSIONS'
11279 ! include 'COMMON.CHAIN'
11280 ! include 'COMMON.DERIV'
11281 ! include 'COMMON.CALC'
11282 ! include 'COMMON.IOUNITS'
11283 real(kind=8), dimension(3) :: dcosom1,dcosom2
11284 ! print *,"wchodze"
11285 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
11286 +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
11287 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
11288 +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
11290 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11291 -2.0D0*alf12*eps3der+sigder*sigsq_om12&
11292 +dCAVdOM12+ dGCLdOM12
11296 ! eom12=evdwij*eps1_om12
11298 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
11300 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
11301 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
11302 !C print *,sss_ele_cut,'in sc_grad'
11304 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11305 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
11308 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
11309 !C print *,'gg',k,gg(k)
11311 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11312 ! write (iout,*) "gg",(gg(k),k=1,3)
11314 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
11315 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11316 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
11319 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
11320 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11321 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
11324 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11325 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11326 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11327 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11330 ! Calculate the components of the gradient in DC and X
11334 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
11338 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
11339 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
11342 end subroutine sc_grad
11344 !-----------------------------------------------------------------------------
11345 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
11348 ! implicit real*8 (a-h,o-z)
11349 ! include 'DIMENSIONS'
11350 ! include 'COMMON.LOCAL'
11351 ! include 'COMMON.IOUNITS'
11352 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
11353 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11354 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
11355 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
11356 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
11358 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
11359 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11360 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
11361 !el local variables
11363 delthec=thetai-thet_pred_mean
11364 delthe0=thetai-theta0i
11365 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
11366 t3 = thetai-thet_pred_mean
11370 t14 = t12+t6*sigsqtc
11372 t21 = thetai-theta0i
11378 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
11379 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
11380 *(-t12*t9-ak*sig0inv*t27)
11382 end subroutine mixder
11384 !-----------------------------------------------------------------------------
11386 !-----------------------------------------------------------------------------
11388 !-----------------------------------------------------------------------------
11389 ! This subroutine calculates the derivatives of the consecutive virtual
11390 ! bond vectors and the SC vectors in the virtual-bond angles theta and
11391 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
11392 ! in the angles alpha and omega, describing the location of a side chain
11393 ! in its local coordinate system.
11395 ! The derivatives are stored in the following arrays:
11397 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
11398 ! The structure is as follows:
11400 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
11401 ! 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)
11402 ! . . . . . . . . . . . . . . . . . .
11403 ! 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)
11407 ! 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)
11409 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
11410 ! The structure is same as above.
11412 ! DCDS - the derivatives of the side chain vectors in the local spherical
11413 ! andgles alph and omega:
11415 ! 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)
11416 ! 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)
11420 ! 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)
11422 ! Version of March '95, based on an early version of November '91.
11424 !**********************************************************************
11425 ! implicit real*8 (a-h,o-z)
11426 ! include 'DIMENSIONS'
11427 ! include 'COMMON.VAR'
11428 ! include 'COMMON.CHAIN'
11429 ! include 'COMMON.DERIV'
11430 ! include 'COMMON.GEO'
11431 ! include 'COMMON.LOCAL'
11432 ! include 'COMMON.INTERACT'
11433 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
11434 real(kind=8),dimension(3,3) :: dp,temp
11435 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
11436 real(kind=8),dimension(3) :: xx,xx1
11437 !el local variables
11438 integer :: i,k,l,j,m,ind,ind1,jjj
11439 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
11440 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
11441 sint2,xp,yp,xxp,yyp,zzp,dj
11443 ! common /przechowalnia/ fromto
11444 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
11445 ! get the position of the jth ijth fragment of the chain coordinate system
11446 ! in the fromto array.
11447 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11449 ! maxdim=(nres-1)*(nres-2)/2
11450 ! allocate(dcdv(6,maxdim),dxds(6,nres))
11451 ! calculate the derivatives of transformation matrix elements in theta
11454 !el call flush(iout) !el
11456 rdt(1,1,i)=-rt(1,2,i)
11457 rdt(1,2,i)= rt(1,1,i)
11459 rdt(2,1,i)=-rt(2,2,i)
11460 rdt(2,2,i)= rt(2,1,i)
11462 rdt(3,1,i)=-rt(3,2,i)
11463 rdt(3,2,i)= rt(3,1,i)
11467 ! derivatives in phi
11473 drt(2,1,i)= rt(3,1,i)
11474 drt(2,2,i)= rt(3,2,i)
11475 drt(2,3,i)= rt(3,3,i)
11476 drt(3,1,i)=-rt(2,1,i)
11477 drt(3,2,i)=-rt(2,2,i)
11478 drt(3,3,i)=-rt(2,3,i)
11481 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
11487 temp(k,l)=rt(k,l,i)
11492 fromto(k,l,ind)=temp(k,l)
11501 dpkl=dpkl+temp(k,m)*rt(m,l,j)
11504 fromto(k,l,ind)=dpkl
11515 ! Calculate derivatives.
11521 ! Derivatives of DC(i+1) in theta(i+2)
11527 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
11530 prordt(j,k,i)=dp(j,k)
11533 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
11536 ! Derivatives of SC(i+1) in theta(i+2)
11538 xx1(1)=-0.5D0*xloc(2,i+1)
11539 xx1(2)= 0.5D0*xloc(1,i+1)
11543 xj=xj+r(j,k,i)*xx1(k)
11550 rj=rj+prod(j,k,i)*xx(k)
11555 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
11556 ! than the other off-diagonal derivatives.
11561 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11563 dxdv(j,ind1+1)=dxoiij
11565 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
11567 ! Derivatives of DC(i+1) in phi(i+2)
11573 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
11576 prodrt(j,k,i)=dp(j,k)
11578 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
11581 ! Derivatives of SC(i+1) in phi(i+2)
11584 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
11585 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
11589 rj=rj+prod(j,k,i)*xx(k)
11594 ! Derivatives of SC(i+1) in phi(i+3).
11599 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11601 dxdv(j+3,ind1+1)=dxoiij
11604 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
11605 ! theta(nres) and phi(i+3) thru phi(nres).
11609 ind=indmat(i+1,j+1)
11610 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
11615 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
11620 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
11621 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
11622 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
11623 ! Derivatives of virtual-bond vectors in theta
11625 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
11627 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
11628 ! Derivatives of SC vectors in theta
11632 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11634 dxdv(k,ind1+1)=dxoijk
11637 !--- Calculate the derivatives in phi
11643 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
11649 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
11654 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11656 dxdv(k+3,ind1+1)=dxoijk
11661 ! Derivatives in alpha and omega:
11664 ! dsci=dsc(itype(i,1))
11669 if(alphi.ne.alphi) alphi=100.0
11670 if(omegi.ne.omegi) omegi=-100.0
11675 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
11676 cosalphi=dcos(alphi)
11677 sinalphi=dsin(alphi)
11678 cosomegi=dcos(omegi)
11679 sinomegi=dsin(omegi)
11680 temp(1,1)=-dsci*sinalphi
11681 temp(2,1)= dsci*cosalphi*cosomegi
11682 temp(3,1)=-dsci*cosalphi*sinomegi
11684 temp(2,2)=-dsci*sinalphi*sinomegi
11685 temp(3,2)=-dsci*sinalphi*cosomegi
11686 theta2=pi-0.5D0*theta(i+1)
11690 !d print *,((temp(l,k),l=1,3),k=1,2)
11694 xxp= xp*cost2+yp*sint2
11695 yyp=-xp*sint2+yp*cost2
11698 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
11699 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
11703 dj=dj+prod(k,l,i-1)*xx(l)
11711 end subroutine cartder
11712 !-----------------------------------------------------------------------------
11714 !-----------------------------------------------------------------------------
11715 subroutine check_cartgrad
11716 ! Check the gradient of Cartesian coordinates in internal coordinates.
11717 ! implicit real*8 (a-h,o-z)
11718 ! include 'DIMENSIONS'
11719 ! include 'COMMON.IOUNITS'
11720 ! include 'COMMON.VAR'
11721 ! include 'COMMON.CHAIN'
11722 ! include 'COMMON.GEO'
11723 ! include 'COMMON.LOCAL'
11724 ! include 'COMMON.DERIV'
11725 real(kind=8),dimension(6,nres) :: temp
11726 real(kind=8),dimension(3) :: xx,gg
11727 integer :: i,k,j,ii
11728 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11729 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11731 ! Check the gradient of the virtual-bond and SC vectors in the internal
11737 write (iout,'(a)') '**************** dx/dalpha'
11741 alph(i)=alph(i)+aincr
11743 temp(k,i)=dc(k,nres+i)
11747 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11748 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11750 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11751 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11757 write (iout,'(a)') '**************** dx/domega'
11761 omeg(i)=omeg(i)+aincr
11763 temp(k,i)=dc(k,nres+i)
11767 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11768 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11769 (aincr*dabs(dxds(k+3,i))+aincr))
11771 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11772 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11778 write (iout,'(a)') '**************** dx/dtheta'
11782 theta(i)=theta(i)+aincr
11785 temp(k,j)=dc(k,nres+j)
11791 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11793 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11794 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11795 (aincr*dabs(dxdv(k,ii))+aincr))
11797 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11798 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11805 write (iout,'(a)') '***************** dx/dphi'
11808 phi(i)=phi(i)+aincr
11811 temp(k,j)=dc(k,nres+j)
11819 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11820 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11821 (aincr*dabs(dxdv(k+3,ii))+aincr))
11823 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11824 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11827 phi(i)=phi(i)-aincr
11830 write (iout,'(a)') '****************** ddc/dtheta'
11833 theta(i+2)=thet+aincr
11844 gg(k)=(dc(k,j)-temp(k,j))/aincr
11845 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11846 (aincr*dabs(dcdv(k,ii))+aincr))
11848 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11849 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11859 write (iout,'(a)') '******************* ddc/dphi'
11862 phi(i+3)=phii+aincr
11873 gg(k)=(dc(k,j)-temp(k,j))/aincr
11874 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11875 (aincr*dabs(dcdv(k+3,ii))+aincr))
11877 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11878 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11889 end subroutine check_cartgrad
11890 !-----------------------------------------------------------------------------
11891 subroutine check_ecart
11892 ! Check the gradient of the energy in Cartesian coordinates.
11893 ! implicit real*8 (a-h,o-z)
11894 ! include 'DIMENSIONS'
11895 ! include 'COMMON.CHAIN'
11896 ! include 'COMMON.DERIV'
11897 ! include 'COMMON.IOUNITS'
11898 ! include 'COMMON.VAR'
11899 ! include 'COMMON.CONTACTS'
11901 !el integer :: icall
11902 !el common /srutu/ icall
11903 real(kind=8),dimension(6) :: ggg
11904 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11905 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11906 real(kind=8),dimension(6,nres) :: grad_s
11907 real(kind=8),dimension(0:n_ene) :: energia,energia1
11908 integer :: uiparm(1)
11909 real(kind=8) :: urparm(1)
11911 integer :: nf,i,j,k
11912 real(kind=8) :: aincr,etot,etot1
11918 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11921 call geom_to_var(nvar,x)
11922 call etotal(energia)
11924 !el call enerprint(energia)
11925 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11928 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11932 grad_s(j,i)=gradc(j,i,icg)
11933 grad_s(j+3,i)=gradx(j,i,icg)
11937 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11942 ddx(j)=dc(j,i+nres)
11945 dc(j,i)=dc(j,i)+aincr
11947 c(j,k)=c(j,k)+aincr
11948 c(j,k+nres)=c(j,k+nres)+aincr
11951 call etotal(energia1)
11953 ggg(j)=(etot1-etot)/aincr
11956 c(j,k)=c(j,k)-aincr
11957 c(j,k+nres)=c(j,k+nres)-aincr
11961 c(j,i+nres)=c(j,i+nres)+aincr
11962 dc(j,i+nres)=dc(j,i+nres)+aincr
11964 call etotal(energia1)
11966 ggg(j+3)=(etot1-etot)/aincr
11968 dc(j,i+nres)=ddx(j)
11970 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11971 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11974 end subroutine check_ecart
11976 !-----------------------------------------------------------------------------
11977 subroutine check_ecartint
11978 ! Check the gradient of the energy in Cartesian coordinates.
11979 use io_base, only: intout
11980 ! implicit real*8 (a-h,o-z)
11981 ! include 'DIMENSIONS'
11982 ! include 'COMMON.CONTROL'
11983 ! include 'COMMON.CHAIN'
11984 ! include 'COMMON.DERIV'
11985 ! include 'COMMON.IOUNITS'
11986 ! include 'COMMON.VAR'
11987 ! include 'COMMON.CONTACTS'
11988 ! include 'COMMON.MD'
11989 ! include 'COMMON.LOCAL'
11990 ! include 'COMMON.SPLITELE'
11992 !el integer :: icall
11993 !el common /srutu/ icall
11994 real(kind=8),dimension(6) :: ggg,ggg1
11995 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11996 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11997 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11998 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11999 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12000 real(kind=8),dimension(0:n_ene) :: energia,energia1
12001 integer :: uiparm(1)
12002 real(kind=8) :: urparm(1)
12004 integer :: i,j,k,nf
12005 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12013 ! call intcartderiv
12014 ! call checkintcartgrad
12017 write(iout,*) 'Calling CHECK_ECARTINT.'
12020 call geom_to_var(nvar,x)
12021 write (iout,*) "split_ene ",split_ene
12023 if (.not.split_ene) then
12025 call etotal(energia)
12030 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12033 grad_s(j,0)=gcart(j,0)
12037 grad_s(j,i)=gcart(j,i)
12038 grad_s(j+3,i)=gxcart(j,i)
12042 !- split gradient check
12044 call etotal_long(energia)
12045 !el call enerprint(energia)
12049 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12050 (gxcart(j,i),j=1,3)
12053 grad_s(j,0)=gcart(j,0)
12057 grad_s(j,i)=gcart(j,i)
12058 grad_s(j+3,i)=gxcart(j,i)
12062 call etotal_short(energia)
12063 call enerprint(energia)
12067 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12068 (gxcart(j,i),j=1,3)
12071 grad_s1(j,0)=gcart(j,0)
12075 grad_s1(j,i)=gcart(j,i)
12076 grad_s1(j+3,i)=gxcart(j,i)
12080 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12084 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
12085 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
12088 dcnorm_safe1(j)=dc_norm(j,i-1)
12089 dcnorm_safe2(j)=dc_norm(j,i)
12090 dxnorm_safe(j)=dc_norm(j,i+nres)
12093 c(j,i)=ddc(j)+aincr
12094 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
12095 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
12096 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12097 dc(j,i)=c(j,i+1)-c(j,i)
12098 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12099 call int_from_cart1(.false.)
12100 if (.not.split_ene) then
12102 call etotal(energia1)
12104 write (iout,*) "ij",i,j," etot1",etot1
12107 call etotal_long(energia1)
12109 call etotal_short(energia1)
12112 !- end split gradient
12113 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12114 c(j,i)=ddc(j)-aincr
12115 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
12116 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
12117 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12118 dc(j,i)=c(j,i+1)-c(j,i)
12119 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12120 call int_from_cart1(.false.)
12121 if (.not.split_ene) then
12123 call etotal(energia1)
12125 write (iout,*) "ij",i,j," etot2",etot2
12126 ggg(j)=(etot1-etot2)/(2*aincr)
12129 call etotal_long(energia1)
12131 ggg(j)=(etot11-etot21)/(2*aincr)
12132 call etotal_short(energia1)
12134 ggg1(j)=(etot12-etot22)/(2*aincr)
12135 !- end split gradient
12136 ! write (iout,*) "etot21",etot21," etot22",etot22
12138 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12140 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
12141 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
12142 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12143 dc(j,i)=c(j,i+1)-c(j,i)
12144 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12145 dc_norm(j,i-1)=dcnorm_safe1(j)
12146 dc_norm(j,i)=dcnorm_safe2(j)
12147 dc_norm(j,i+nres)=dxnorm_safe(j)
12150 c(j,i+nres)=ddx(j)+aincr
12151 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12152 call int_from_cart1(.false.)
12153 if (.not.split_ene) then
12155 call etotal(energia1)
12159 call etotal_long(energia1)
12161 call etotal_short(energia1)
12164 !- end split gradient
12165 c(j,i+nres)=ddx(j)-aincr
12166 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12167 call int_from_cart1(.false.)
12168 if (.not.split_ene) then
12170 call etotal(energia1)
12172 ggg(j+3)=(etot1-etot2)/(2*aincr)
12175 call etotal_long(energia1)
12177 ggg(j+3)=(etot11-etot21)/(2*aincr)
12178 call etotal_short(energia1)
12180 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12181 !- end split gradient
12183 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12185 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12186 dc_norm(j,i+nres)=dxnorm_safe(j)
12187 call int_from_cart1(.false.)
12189 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12190 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12191 if (split_ene) then
12192 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12193 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12195 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12196 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12197 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12201 end subroutine check_ecartint
12203 !-----------------------------------------------------------------------------
12204 subroutine check_ecartint
12205 ! Check the gradient of the energy in Cartesian coordinates.
12206 use io_base, only: intout
12207 ! implicit real*8 (a-h,o-z)
12208 ! include 'DIMENSIONS'
12209 ! include 'COMMON.CONTROL'
12210 ! include 'COMMON.CHAIN'
12211 ! include 'COMMON.DERIV'
12212 ! include 'COMMON.IOUNITS'
12213 ! include 'COMMON.VAR'
12214 ! include 'COMMON.CONTACTS'
12215 ! include 'COMMON.MD'
12216 ! include 'COMMON.LOCAL'
12217 ! include 'COMMON.SPLITELE'
12219 !el integer :: icall
12220 !el common /srutu/ icall
12221 real(kind=8),dimension(6) :: ggg,ggg1
12222 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12223 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12224 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
12225 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12226 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12227 real(kind=8),dimension(0:n_ene) :: energia,energia1
12228 integer :: uiparm(1)
12229 real(kind=8) :: urparm(1)
12231 integer :: i,j,k,nf
12232 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12240 ! call intcartderiv
12241 ! call checkintcartgrad
12244 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
12247 call geom_to_var(nvar,x)
12248 if (.not.split_ene) then
12249 call etotal(energia)
12251 !el call enerprint(energia)
12255 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12258 grad_s(j,0)=gcart(j,0)
12262 grad_s(j,i)=gcart(j,i)
12263 ! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
12265 ! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
12266 grad_s(j+3,i)=gxcart(j,i)
12270 !- split gradient check
12272 call etotal_long(energia)
12273 !el call enerprint(energia)
12277 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12278 (gxcart(j,i),j=1,3)
12281 grad_s(j,0)=gcart(j,0)
12285 grad_s(j,i)=gcart(j,i)
12286 ! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
12287 grad_s(j+3,i)=gxcart(j,i)
12291 call etotal_short(energia)
12292 !el call enerprint(energia)
12296 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12297 (gxcart(j,i),j=1,3)
12300 grad_s1(j,0)=gcart(j,0)
12304 grad_s1(j,i)=gcart(j,i)
12305 grad_s1(j+3,i)=gxcart(j,i)
12309 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12314 ddx(j)=dc(j,i+nres)
12316 dcnorm_safe(k)=dc_norm(k,i)
12317 dxnorm_safe(k)=dc_norm(k,i+nres)
12321 dc(j,i)=ddc(j)+aincr
12322 call chainbuild_cart
12324 ! Broadcast the order to compute internal coordinates to the slaves.
12325 ! if (nfgtasks.gt.1)
12326 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12328 ! call int_from_cart1(.false.)
12329 if (.not.split_ene) then
12331 call etotal(energia1)
12333 ! call enerprint(energia1)
12336 call etotal_long(energia1)
12338 call etotal_short(energia1)
12340 ! write (iout,*) "etot11",etot11," etot12",etot12
12342 !- end split gradient
12343 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12344 dc(j,i)=ddc(j)-aincr
12345 call chainbuild_cart
12346 ! call int_from_cart1(.false.)
12347 if (.not.split_ene) then
12349 call etotal(energia1)
12351 ggg(j)=(etot1-etot2)/(2*aincr)
12354 call etotal_long(energia1)
12356 ggg(j)=(etot11-etot21)/(2*aincr)
12357 call etotal_short(energia1)
12359 ggg1(j)=(etot12-etot22)/(2*aincr)
12360 !- end split gradient
12361 ! write (iout,*) "etot21",etot21," etot22",etot22
12363 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12365 call chainbuild_cart
12368 dc(j,i+nres)=ddx(j)+aincr
12369 call chainbuild_cart
12370 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
12371 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12372 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12373 ! write (iout,*) "dxnormnorm",dsqrt(
12374 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12375 ! write (iout,*) "dxnormnormsafe",dsqrt(
12376 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12378 if (.not.split_ene) then
12380 call etotal(energia1)
12384 call etotal_long(energia1)
12386 call etotal_short(energia1)
12389 !- end split gradient
12390 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12391 dc(j,i+nres)=ddx(j)-aincr
12392 call chainbuild_cart
12393 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
12394 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12395 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12397 ! write (iout,*) "dxnormnorm",dsqrt(
12398 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12399 ! write (iout,*) "dxnormnormsafe",dsqrt(
12400 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12401 if (.not.split_ene) then
12403 call etotal(energia1)
12405 ggg(j+3)=(etot1-etot2)/(2*aincr)
12408 call etotal_long(energia1)
12410 ggg(j+3)=(etot11-etot21)/(2*aincr)
12411 call etotal_short(energia1)
12413 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12414 !- end split gradient
12416 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12417 dc(j,i+nres)=ddx(j)
12418 call chainbuild_cart
12420 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12421 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12422 if (split_ene) then
12423 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12424 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12426 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12427 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12428 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12432 end subroutine check_ecartint
12434 !-----------------------------------------------------------------------------
12435 subroutine check_eint
12436 ! Check the gradient of energy in internal coordinates.
12437 ! implicit real*8 (a-h,o-z)
12438 ! include 'DIMENSIONS'
12439 ! include 'COMMON.CHAIN'
12440 ! include 'COMMON.DERIV'
12441 ! include 'COMMON.IOUNITS'
12442 ! include 'COMMON.VAR'
12443 ! include 'COMMON.GEO'
12445 !el integer :: icall
12446 !el common /srutu/ icall
12447 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
12448 integer :: uiparm(1)
12449 real(kind=8) :: urparm(1)
12450 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
12451 character(len=6) :: key
12454 real(kind=8) :: xi,aincr,etot,etot1,etot2
12457 print '(a)','Calling CHECK_INT.'
12461 call geom_to_var(nvar,x)
12462 call var_to_geom(nvar,x)
12465 ! print *,'ICG=',ICG
12466 call etotal(energia)
12468 !el call enerprint(energia)
12469 ! print *,'ICG=',ICG
12471 if (MyID.ne.BossID) then
12472 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
12480 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
12481 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
12482 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
12486 x(i)=xi-0.5D0*aincr
12487 call var_to_geom(nvar,x)
12489 call etotal(energia1)
12491 x(i)=xi+0.5D0*aincr
12492 call var_to_geom(nvar,x)
12494 call etotal(energia2)
12496 gg(i)=(etot2-etot1)/aincr
12497 write (iout,*) i,etot1,etot2
12500 write (iout,'(/2a)')' Variable Numerical Analytical',&
12503 if (i.le.nphi) then
12506 else if (i.le.nphi+ntheta) then
12509 else if (i.le.nphi+ntheta+nside) then
12513 ii=i-(nphi+ntheta+nside)
12516 write (iout,'(i3,a,i3,3(1pd16.6))') &
12517 i,key,ii,gg(i),gana(i),&
12518 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
12521 end subroutine check_eint
12522 !-----------------------------------------------------------------------------
12524 !-----------------------------------------------------------------------------
12525 subroutine Econstr_back
12526 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
12527 ! implicit real*8 (a-h,o-z)
12528 ! include 'DIMENSIONS'
12529 ! include 'COMMON.CONTROL'
12530 ! include 'COMMON.VAR'
12531 ! include 'COMMON.MD'
12534 ! include 'COMMON.LANGEVIN'
12536 ! include 'COMMON.LANGEVIN.lang0'
12538 ! include 'COMMON.CHAIN'
12539 ! include 'COMMON.DERIV'
12540 ! include 'COMMON.GEO'
12541 ! include 'COMMON.LOCAL'
12542 ! include 'COMMON.INTERACT'
12543 ! include 'COMMON.IOUNITS'
12544 ! include 'COMMON.NAMES'
12545 ! include 'COMMON.TIME1'
12546 integer :: i,j,ii,k
12547 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
12549 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
12550 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
12551 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
12558 duscdiff(j,i)=0.0d0
12559 duscdiffx(j,i)=0.0d0
12563 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
12565 ! Deviations from theta angles
12568 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
12569 dtheta_i=theta(j)-thetaref(j)
12570 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
12571 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
12573 utheta(i)=utheta_i/(ii-1)
12575 ! Deviations from gamma angles
12578 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
12579 dgamma_i=pinorm(phi(j)-phiref(j))
12580 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
12581 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
12582 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
12583 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
12585 ugamma(i)=ugamma_i/(ii-2)
12587 ! Deviations from local SC geometry
12590 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
12591 dxx=xxtab(j)-xxref(j)
12592 dyy=yytab(j)-yyref(j)
12593 dzz=zztab(j)-zzref(j)
12594 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
12596 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
12597 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
12599 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
12600 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
12602 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
12603 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
12606 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
12607 ! & xxref(j),yyref(j),zzref(j)
12609 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
12610 ! write (iout,*) i," uscdiff",uscdiff(i)
12612 ! Put together deviations from local geometry
12614 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
12615 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
12616 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
12617 ! & " uconst_back",uconst_back
12618 utheta(i)=dsqrt(utheta(i))
12619 ugamma(i)=dsqrt(ugamma(i))
12620 uscdiff(i)=dsqrt(uscdiff(i))
12623 end subroutine Econstr_back
12624 !-----------------------------------------------------------------------------
12625 ! energy_p_new-sep_barrier.F
12626 !-----------------------------------------------------------------------------
12627 real(kind=8) function sscale(r)
12628 ! include "COMMON.SPLITELE"
12629 real(kind=8) :: r,gamm
12630 if(r.lt.r_cut-rlamb) then
12632 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12633 gamm=(r-(r_cut-rlamb))/rlamb
12634 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12639 end function sscale
12640 real(kind=8) function sscale_grad(r)
12641 ! include "COMMON.SPLITELE"
12642 real(kind=8) :: r,gamm
12643 if(r.lt.r_cut-rlamb) then
12645 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12646 gamm=(r-(r_cut-rlamb))/rlamb
12647 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
12652 end function sscale_grad
12654 !!!!!!!!!! PBCSCALE
12655 real(kind=8) function sscale_ele(r)
12656 ! include "COMMON.SPLITELE"
12657 real(kind=8) :: r,gamm
12658 if(r.lt.r_cut_ele-rlamb_ele) then
12660 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12661 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12662 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12667 end function sscale_ele
12669 real(kind=8) function sscagrad_ele(r)
12670 real(kind=8) :: r,gamm
12671 ! include "COMMON.SPLITELE"
12672 if(r.lt.r_cut_ele-rlamb_ele) then
12674 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12675 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12676 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12681 end function sscagrad_ele
12682 real(kind=8) function sscalelip(r)
12683 real(kind=8) r,gamm
12684 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12686 end function sscalelip
12687 !C-----------------------------------------------------------------------
12688 real(kind=8) function sscagradlip(r)
12689 real(kind=8) r,gamm
12690 sscagradlip=r*(6.0d0*r-6.0d0)
12692 end function sscagradlip
12695 !-----------------------------------------------------------------------------
12696 subroutine elj_long(evdw)
12698 ! This subroutine calculates the interaction energy of nonbonded side chains
12699 ! assuming the LJ potential of interaction.
12701 ! implicit real*8 (a-h,o-z)
12702 ! include 'DIMENSIONS'
12703 ! include 'COMMON.GEO'
12704 ! include 'COMMON.VAR'
12705 ! include 'COMMON.LOCAL'
12706 ! include 'COMMON.CHAIN'
12707 ! include 'COMMON.DERIV'
12708 ! include 'COMMON.INTERACT'
12709 ! include 'COMMON.TORSION'
12710 ! include 'COMMON.SBRIDGE'
12711 ! include 'COMMON.NAMES'
12712 ! include 'COMMON.IOUNITS'
12713 ! include 'COMMON.CONTACTS'
12714 real(kind=8),parameter :: accur=1.0d-10
12715 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12716 !el local variables
12717 integer :: i,iint,j,k,itypi,itypi1,itypj
12718 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12719 real(kind=8) :: e1,e2,evdwij,evdw
12720 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12722 do i=iatsc_s,iatsc_e
12724 if (itypi.eq.ntyp1) cycle
12725 itypi1=itype(i+1,1)
12730 ! Calculate SC interaction energy.
12732 do iint=1,nint_gr(i)
12733 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12734 !d & 'iend=',iend(i,iint)
12735 do j=istart(i,iint),iend(i,iint)
12737 if (itypj.eq.ntyp1) cycle
12741 rij=xj*xj+yj*yj+zj*zj
12742 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12743 if (sss.lt.1.0d0) then
12745 eps0ij=eps(itypi,itypj)
12747 e1=fac*fac*aa_aq(itypi,itypj)
12748 e2=fac*bb_aq(itypi,itypj)
12750 evdw=evdw+(1.0d0-sss)*evdwij
12752 ! Calculate the components of the gradient in DC and X
12754 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12759 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12760 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12761 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12762 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12770 gvdwc(j,i)=expon*gvdwc(j,i)
12771 gvdwx(j,i)=expon*gvdwx(j,i)
12774 !******************************************************************************
12778 ! To save time, the factor of EXPON has been extracted from ALL components
12779 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12782 !******************************************************************************
12784 end subroutine elj_long
12785 !-----------------------------------------------------------------------------
12786 subroutine elj_short(evdw)
12788 ! This subroutine calculates the interaction energy of nonbonded side chains
12789 ! assuming the LJ potential of interaction.
12791 ! implicit real*8 (a-h,o-z)
12792 ! include 'DIMENSIONS'
12793 ! include 'COMMON.GEO'
12794 ! include 'COMMON.VAR'
12795 ! include 'COMMON.LOCAL'
12796 ! include 'COMMON.CHAIN'
12797 ! include 'COMMON.DERIV'
12798 ! include 'COMMON.INTERACT'
12799 ! include 'COMMON.TORSION'
12800 ! include 'COMMON.SBRIDGE'
12801 ! include 'COMMON.NAMES'
12802 ! include 'COMMON.IOUNITS'
12803 ! include 'COMMON.CONTACTS'
12804 real(kind=8),parameter :: accur=1.0d-10
12805 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12806 !el local variables
12807 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12808 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12809 real(kind=8) :: e1,e2,evdwij,evdw
12810 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12812 do i=iatsc_s,iatsc_e
12814 if (itypi.eq.ntyp1) cycle
12815 itypi1=itype(i+1,1)
12822 ! Calculate SC interaction energy.
12824 do iint=1,nint_gr(i)
12825 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12826 !d & 'iend=',iend(i,iint)
12827 do j=istart(i,iint),iend(i,iint)
12829 if (itypj.eq.ntyp1) cycle
12833 ! Change 12/1/95 to calculate four-body interactions
12834 rij=xj*xj+yj*yj+zj*zj
12835 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12836 if (sss.gt.0.0d0) then
12838 eps0ij=eps(itypi,itypj)
12840 e1=fac*fac*aa_aq(itypi,itypj)
12841 e2=fac*bb_aq(itypi,itypj)
12843 evdw=evdw+sss*evdwij
12845 ! Calculate the components of the gradient in DC and X
12847 fac=-rrij*(e1+evdwij)*sss
12852 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12853 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12854 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12855 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12863 gvdwc(j,i)=expon*gvdwc(j,i)
12864 gvdwx(j,i)=expon*gvdwx(j,i)
12867 !******************************************************************************
12871 ! To save time, the factor of EXPON has been extracted from ALL components
12872 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12875 !******************************************************************************
12877 end subroutine elj_short
12878 !-----------------------------------------------------------------------------
12879 subroutine eljk_long(evdw)
12881 ! This subroutine calculates the interaction energy of nonbonded side chains
12882 ! assuming the LJK potential of interaction.
12884 ! implicit real*8 (a-h,o-z)
12885 ! include 'DIMENSIONS'
12886 ! include 'COMMON.GEO'
12887 ! include 'COMMON.VAR'
12888 ! include 'COMMON.LOCAL'
12889 ! include 'COMMON.CHAIN'
12890 ! include 'COMMON.DERIV'
12891 ! include 'COMMON.INTERACT'
12892 ! include 'COMMON.IOUNITS'
12893 ! include 'COMMON.NAMES'
12894 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12896 !el local variables
12897 integer :: i,iint,j,k,itypi,itypi1,itypj
12898 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12899 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12900 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12902 do i=iatsc_s,iatsc_e
12904 if (itypi.eq.ntyp1) cycle
12905 itypi1=itype(i+1,1)
12910 ! Calculate SC interaction energy.
12912 do iint=1,nint_gr(i)
12913 do j=istart(i,iint),iend(i,iint)
12915 if (itypj.eq.ntyp1) cycle
12919 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12920 fac_augm=rrij**expon
12921 e_augm=augm(itypi,itypj)*fac_augm
12922 r_inv_ij=dsqrt(rrij)
12924 sss=sscale(rij/sigma(itypi,itypj))
12925 if (sss.lt.1.0d0) then
12926 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12927 fac=r_shift_inv**expon
12928 e1=fac*fac*aa_aq(itypi,itypj)
12929 e2=fac*bb_aq(itypi,itypj)
12930 evdwij=e_augm+e1+e2
12931 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12932 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12933 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12934 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12935 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12936 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12937 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12938 evdw=evdw+(1.0d0-sss)*evdwij
12940 ! Calculate the components of the gradient in DC and X
12942 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12943 fac=fac*(1.0d0-sss)
12948 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12949 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12950 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12951 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12959 gvdwc(j,i)=expon*gvdwc(j,i)
12960 gvdwx(j,i)=expon*gvdwx(j,i)
12964 end subroutine eljk_long
12965 !-----------------------------------------------------------------------------
12966 subroutine eljk_short(evdw)
12968 ! This subroutine calculates the interaction energy of nonbonded side chains
12969 ! assuming the LJK potential of interaction.
12971 ! implicit real*8 (a-h,o-z)
12972 ! include 'DIMENSIONS'
12973 ! include 'COMMON.GEO'
12974 ! include 'COMMON.VAR'
12975 ! include 'COMMON.LOCAL'
12976 ! include 'COMMON.CHAIN'
12977 ! include 'COMMON.DERIV'
12978 ! include 'COMMON.INTERACT'
12979 ! include 'COMMON.IOUNITS'
12980 ! include 'COMMON.NAMES'
12981 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12983 !el local variables
12984 integer :: i,iint,j,k,itypi,itypi1,itypj
12985 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12986 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12987 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12989 do i=iatsc_s,iatsc_e
12991 if (itypi.eq.ntyp1) cycle
12992 itypi1=itype(i+1,1)
12997 ! Calculate SC interaction energy.
12999 do iint=1,nint_gr(i)
13000 do j=istart(i,iint),iend(i,iint)
13002 if (itypj.eq.ntyp1) cycle
13006 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13007 fac_augm=rrij**expon
13008 e_augm=augm(itypi,itypj)*fac_augm
13009 r_inv_ij=dsqrt(rrij)
13011 sss=sscale(rij/sigma(itypi,itypj))
13012 if (sss.gt.0.0d0) then
13013 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
13014 fac=r_shift_inv**expon
13015 e1=fac*fac*aa_aq(itypi,itypj)
13016 e2=fac*bb_aq(itypi,itypj)
13017 evdwij=e_augm+e1+e2
13018 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
13019 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
13020 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
13021 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
13022 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
13023 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
13024 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
13025 evdw=evdw+sss*evdwij
13027 ! Calculate the components of the gradient in DC and X
13029 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
13035 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13036 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13037 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13038 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13046 gvdwc(j,i)=expon*gvdwc(j,i)
13047 gvdwx(j,i)=expon*gvdwx(j,i)
13051 end subroutine eljk_short
13052 !-----------------------------------------------------------------------------
13053 subroutine ebp_long(evdw)
13055 ! This subroutine calculates the interaction energy of nonbonded side chains
13056 ! assuming the Berne-Pechukas potential of interaction.
13059 ! implicit real*8 (a-h,o-z)
13060 ! include 'DIMENSIONS'
13061 ! include 'COMMON.GEO'
13062 ! include 'COMMON.VAR'
13063 ! include 'COMMON.LOCAL'
13064 ! include 'COMMON.CHAIN'
13065 ! include 'COMMON.DERIV'
13066 ! include 'COMMON.NAMES'
13067 ! include 'COMMON.INTERACT'
13068 ! include 'COMMON.IOUNITS'
13069 ! include 'COMMON.CALC'
13071 !el integer :: icall
13072 !el common /srutu/ icall
13073 ! double precision rrsave(maxdim)
13075 !el local variables
13076 integer :: iint,itypi,itypi1,itypj
13077 real(kind=8) :: rrij,xi,yi,zi,fac
13078 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
13080 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13082 ! if (icall.eq.0) then
13088 do i=iatsc_s,iatsc_e
13090 if (itypi.eq.ntyp1) cycle
13091 itypi1=itype(i+1,1)
13095 dxi=dc_norm(1,nres+i)
13096 dyi=dc_norm(2,nres+i)
13097 dzi=dc_norm(3,nres+i)
13098 ! dsci_inv=dsc_inv(itypi)
13099 dsci_inv=vbld_inv(i+nres)
13101 ! Calculate SC interaction energy.
13103 do iint=1,nint_gr(i)
13104 do j=istart(i,iint),iend(i,iint)
13107 if (itypj.eq.ntyp1) cycle
13108 ! dscj_inv=dsc_inv(itypj)
13109 dscj_inv=vbld_inv(j+nres)
13110 chi1=chi(itypi,itypj)
13111 chi2=chi(itypj,itypi)
13118 alf12=0.5D0*(alf1+alf2)
13122 dxj=dc_norm(1,nres+j)
13123 dyj=dc_norm(2,nres+j)
13124 dzj=dc_norm(3,nres+j)
13125 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13127 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13129 if (sss.lt.1.0d0) then
13131 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13133 ! Calculate whole angle-dependent part of epsilon and contributions
13134 ! to its derivatives
13135 fac=(rrij*sigsq)**expon2
13136 e1=fac*fac*aa_aq(itypi,itypj)
13137 e2=fac*bb_aq(itypi,itypj)
13138 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13139 eps2der=evdwij*eps3rt
13140 eps3der=evdwij*eps2rt
13141 evdwij=evdwij*eps2rt*eps3rt
13142 evdw=evdw+evdwij*(1.0d0-sss)
13144 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13145 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13146 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13147 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13148 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13149 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13150 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13153 ! Calculate gradient components.
13154 e1=e1*eps1*eps2rt**2*eps3rt**2
13155 fac=-expon*(e1+evdwij)
13158 ! Calculate radial part of the gradient
13162 ! Calculate the angular part of the gradient and sum add the contributions
13163 ! to the appropriate components of the Cartesian gradient.
13164 call sc_grad_scale(1.0d0-sss)
13171 end subroutine ebp_long
13172 !-----------------------------------------------------------------------------
13173 subroutine ebp_short(evdw)
13175 ! This subroutine calculates the interaction energy of nonbonded side chains
13176 ! assuming the Berne-Pechukas potential of interaction.
13179 ! implicit real*8 (a-h,o-z)
13180 ! include 'DIMENSIONS'
13181 ! include 'COMMON.GEO'
13182 ! include 'COMMON.VAR'
13183 ! include 'COMMON.LOCAL'
13184 ! include 'COMMON.CHAIN'
13185 ! include 'COMMON.DERIV'
13186 ! include 'COMMON.NAMES'
13187 ! include 'COMMON.INTERACT'
13188 ! include 'COMMON.IOUNITS'
13189 ! include 'COMMON.CALC'
13191 !el integer :: icall
13192 !el common /srutu/ icall
13193 ! double precision rrsave(maxdim)
13195 !el local variables
13196 integer :: iint,itypi,itypi1,itypj
13197 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
13198 real(kind=8) :: sss,e1,e2,evdw
13200 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13202 ! if (icall.eq.0) then
13208 do i=iatsc_s,iatsc_e
13210 if (itypi.eq.ntyp1) cycle
13211 itypi1=itype(i+1,1)
13215 dxi=dc_norm(1,nres+i)
13216 dyi=dc_norm(2,nres+i)
13217 dzi=dc_norm(3,nres+i)
13218 ! dsci_inv=dsc_inv(itypi)
13219 dsci_inv=vbld_inv(i+nres)
13221 ! Calculate SC interaction energy.
13223 do iint=1,nint_gr(i)
13224 do j=istart(i,iint),iend(i,iint)
13227 if (itypj.eq.ntyp1) cycle
13228 ! dscj_inv=dsc_inv(itypj)
13229 dscj_inv=vbld_inv(j+nres)
13230 chi1=chi(itypi,itypj)
13231 chi2=chi(itypj,itypi)
13238 alf12=0.5D0*(alf1+alf2)
13242 dxj=dc_norm(1,nres+j)
13243 dyj=dc_norm(2,nres+j)
13244 dzj=dc_norm(3,nres+j)
13245 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13247 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13249 if (sss.gt.0.0d0) then
13251 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13253 ! Calculate whole angle-dependent part of epsilon and contributions
13254 ! to its derivatives
13255 fac=(rrij*sigsq)**expon2
13256 e1=fac*fac*aa_aq(itypi,itypj)
13257 e2=fac*bb_aq(itypi,itypj)
13258 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13259 eps2der=evdwij*eps3rt
13260 eps3der=evdwij*eps2rt
13261 evdwij=evdwij*eps2rt*eps3rt
13262 evdw=evdw+evdwij*sss
13264 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13265 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13266 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13267 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13268 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13269 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13270 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13273 ! Calculate gradient components.
13274 e1=e1*eps1*eps2rt**2*eps3rt**2
13275 fac=-expon*(e1+evdwij)
13278 ! Calculate radial part of the gradient
13282 ! Calculate the angular part of the gradient and sum add the contributions
13283 ! to the appropriate components of the Cartesian gradient.
13284 call sc_grad_scale(sss)
13291 end subroutine ebp_short
13292 !-----------------------------------------------------------------------------
13293 subroutine egb_long(evdw)
13295 ! This subroutine calculates the interaction energy of nonbonded side chains
13296 ! assuming the Gay-Berne potential of interaction.
13299 ! implicit real*8 (a-h,o-z)
13300 ! include 'DIMENSIONS'
13301 ! include 'COMMON.GEO'
13302 ! include 'COMMON.VAR'
13303 ! include 'COMMON.LOCAL'
13304 ! include 'COMMON.CHAIN'
13305 ! include 'COMMON.DERIV'
13306 ! include 'COMMON.NAMES'
13307 ! include 'COMMON.INTERACT'
13308 ! include 'COMMON.IOUNITS'
13309 ! include 'COMMON.CALC'
13310 ! include 'COMMON.CONTROL'
13312 !el local variables
13313 integer :: iint,itypi,itypi1,itypj,subchap
13314 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13315 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13316 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13317 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13318 ssgradlipi,ssgradlipj
13322 !cccc energy_dec=.false.
13323 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13326 ! if (icall.eq.0) lprn=.false.
13328 do i=iatsc_s,iatsc_e
13330 if (itypi.eq.ntyp1) cycle
13331 itypi1=itype(i+1,1)
13335 xi=mod(xi,boxxsize)
13336 if (xi.lt.0) xi=xi+boxxsize
13337 yi=mod(yi,boxysize)
13338 if (yi.lt.0) yi=yi+boxysize
13339 zi=mod(zi,boxzsize)
13340 if (zi.lt.0) zi=zi+boxzsize
13341 if ((zi.gt.bordlipbot) &
13342 .and.(zi.lt.bordliptop)) then
13343 !C the energy transfer exist
13344 if (zi.lt.buflipbot) then
13345 !C what fraction I am in
13347 ((zi-bordlipbot)/lipbufthick)
13348 !C lipbufthick is thickenes of lipid buffore
13349 sslipi=sscalelip(fracinbuf)
13350 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13351 elseif (zi.gt.bufliptop) then
13352 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13353 sslipi=sscalelip(fracinbuf)
13354 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13364 dxi=dc_norm(1,nres+i)
13365 dyi=dc_norm(2,nres+i)
13366 dzi=dc_norm(3,nres+i)
13367 ! dsci_inv=dsc_inv(itypi)
13368 dsci_inv=vbld_inv(i+nres)
13369 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13370 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13372 ! Calculate SC interaction energy.
13374 do iint=1,nint_gr(i)
13375 do j=istart(i,iint),iend(i,iint)
13376 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13377 ! call dyn_ssbond_ene(i,j,evdwij)
13379 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13380 ! 'evdw',i,j,evdwij,' ss'
13381 ! if (energy_dec) write (iout,*) &
13382 ! 'evdw',i,j,evdwij,' ss'
13383 ! do k=j+1,iend(i,iint)
13384 !C search over all next residues
13385 ! if (dyn_ss_mask(k)) then
13386 !C check if they are cysteins
13387 !C write(iout,*) 'k=',k
13389 !c write(iout,*) "PRZED TRI", evdwij
13390 ! evdwij_przed_tri=evdwij
13391 ! call triple_ssbond_ene(i,j,k,evdwij)
13392 !c if(evdwij_przed_tri.ne.evdwij) then
13393 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13396 !c write(iout,*) "PO TRI", evdwij
13397 !C call the energy function that removes the artifical triple disulfide
13398 !C bond the soubroutine is located in ssMD.F
13400 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13401 'evdw',i,j,evdwij,'tss'
13402 ! endif!dyn_ss_mask(k)
13408 if (itypj.eq.ntyp1) cycle
13409 ! dscj_inv=dsc_inv(itypj)
13410 dscj_inv=vbld_inv(j+nres)
13411 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13412 ! & 1.0d0/vbld(j+nres)
13413 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13414 sig0ij=sigma(itypi,itypj)
13415 chi1=chi(itypi,itypj)
13416 chi2=chi(itypj,itypi)
13423 alf12=0.5D0*(alf1+alf2)
13427 ! Searching for nearest neighbour
13428 xj=mod(xj,boxxsize)
13429 if (xj.lt.0) xj=xj+boxxsize
13430 yj=mod(yj,boxysize)
13431 if (yj.lt.0) yj=yj+boxysize
13432 zj=mod(zj,boxzsize)
13433 if (zj.lt.0) zj=zj+boxzsize
13434 if ((zj.gt.bordlipbot) &
13435 .and.(zj.lt.bordliptop)) then
13436 !C the energy transfer exist
13437 if (zj.lt.buflipbot) then
13438 !C what fraction I am in
13440 ((zj-bordlipbot)/lipbufthick)
13441 !C lipbufthick is thickenes of lipid buffore
13442 sslipj=sscalelip(fracinbuf)
13443 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13444 elseif (zj.gt.bufliptop) then
13445 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13446 sslipj=sscalelip(fracinbuf)
13447 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13456 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13457 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13458 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13459 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13461 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13469 xj=xj_safe+xshift*boxxsize
13470 yj=yj_safe+yshift*boxysize
13471 zj=zj_safe+zshift*boxzsize
13472 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13473 if(dist_temp.lt.dist_init) then
13474 dist_init=dist_temp
13483 if (subchap.eq.1) then
13493 dxj=dc_norm(1,nres+j)
13494 dyj=dc_norm(2,nres+j)
13495 dzj=dc_norm(3,nres+j)
13496 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13498 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13499 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13500 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13501 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13502 if (sss_ele_cut.le.0.0) cycle
13503 if (sss.lt.1.0d0) then
13505 ! Calculate angle-dependent terms of energy and contributions to their
13509 sig=sig0ij*dsqrt(sigsq)
13510 rij_shift=1.0D0/rij-sig+sig0ij
13511 ! for diagnostics; uncomment
13512 ! rij_shift=1.2*sig0ij
13513 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13514 if (rij_shift.le.0.0D0) then
13516 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13517 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13518 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13522 !---------------------------------------------------------------
13523 rij_shift=1.0D0/rij_shift
13524 fac=rij_shift**expon
13527 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13528 eps2der=evdwij*eps3rt
13529 eps3der=evdwij*eps2rt
13530 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13531 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13532 evdwij=evdwij*eps2rt*eps3rt
13533 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
13535 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13536 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13537 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13538 restyp(itypi,1),i,restyp(itypj,1),j,&
13539 epsi,sigm,chi1,chi2,chip1,chip2,&
13540 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13541 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13545 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13547 ! if (energy_dec) write (iout,*) &
13548 ! 'evdw',i,j,evdwij,"egb_long"
13550 ! Calculate gradient components.
13551 e1=e1*eps1*eps2rt**2*eps3rt**2
13552 fac=-expon*(e1+evdwij)*rij_shift
13555 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13556 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
13557 /sigmaii(itypi,itypj))
13559 ! Calculate the radial part of the gradient
13563 ! Calculate angular part of the gradient.
13564 call sc_grad_scale(1.0d0-sss)
13570 ! write (iout,*) "Number of loop steps in EGB:",ind
13571 !ccc energy_dec=.false.
13573 end subroutine egb_long
13574 !-----------------------------------------------------------------------------
13575 subroutine egb_short(evdw)
13577 ! This subroutine calculates the interaction energy of nonbonded side chains
13578 ! assuming the Gay-Berne potential of interaction.
13581 ! implicit real*8 (a-h,o-z)
13582 ! include 'DIMENSIONS'
13583 ! include 'COMMON.GEO'
13584 ! include 'COMMON.VAR'
13585 ! include 'COMMON.LOCAL'
13586 ! include 'COMMON.CHAIN'
13587 ! include 'COMMON.DERIV'
13588 ! include 'COMMON.NAMES'
13589 ! include 'COMMON.INTERACT'
13590 ! include 'COMMON.IOUNITS'
13591 ! include 'COMMON.CALC'
13592 ! include 'COMMON.CONTROL'
13594 !el local variables
13595 integer :: iint,itypi,itypi1,itypj,subchap
13596 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
13597 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
13598 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13599 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13600 ssgradlipi,ssgradlipj
13602 !cccc energy_dec=.false.
13603 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13606 ! if (icall.eq.0) lprn=.false.
13608 do i=iatsc_s,iatsc_e
13610 if (itypi.eq.ntyp1) cycle
13611 itypi1=itype(i+1,1)
13615 xi=mod(xi,boxxsize)
13616 if (xi.lt.0) xi=xi+boxxsize
13617 yi=mod(yi,boxysize)
13618 if (yi.lt.0) yi=yi+boxysize
13619 zi=mod(zi,boxzsize)
13620 if (zi.lt.0) zi=zi+boxzsize
13621 if ((zi.gt.bordlipbot) &
13622 .and.(zi.lt.bordliptop)) then
13623 !C the energy transfer exist
13624 if (zi.lt.buflipbot) then
13625 !C what fraction I am in
13627 ((zi-bordlipbot)/lipbufthick)
13628 !C lipbufthick is thickenes of lipid buffore
13629 sslipi=sscalelip(fracinbuf)
13630 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13631 elseif (zi.gt.bufliptop) then
13632 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13633 sslipi=sscalelip(fracinbuf)
13634 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13644 dxi=dc_norm(1,nres+i)
13645 dyi=dc_norm(2,nres+i)
13646 dzi=dc_norm(3,nres+i)
13647 ! dsci_inv=dsc_inv(itypi)
13648 dsci_inv=vbld_inv(i+nres)
13650 dxi=dc_norm(1,nres+i)
13651 dyi=dc_norm(2,nres+i)
13652 dzi=dc_norm(3,nres+i)
13653 ! dsci_inv=dsc_inv(itypi)
13654 dsci_inv=vbld_inv(i+nres)
13655 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13656 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13658 ! Calculate SC interaction energy.
13660 do iint=1,nint_gr(i)
13661 do j=istart(i,iint),iend(i,iint)
13662 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13663 call dyn_ssbond_ene(i,j,evdwij)
13665 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13666 'evdw',i,j,evdwij,' ss'
13667 do k=j+1,iend(i,iint)
13668 !C search over all next residues
13669 if (dyn_ss_mask(k)) then
13670 !C check if they are cysteins
13671 !C write(iout,*) 'k=',k
13673 !c write(iout,*) "PRZED TRI", evdwij
13674 ! evdwij_przed_tri=evdwij
13675 call triple_ssbond_ene(i,j,k,evdwij)
13676 !c if(evdwij_przed_tri.ne.evdwij) then
13677 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13680 !c write(iout,*) "PO TRI", evdwij
13681 !C call the energy function that removes the artifical triple disulfide
13682 !C bond the soubroutine is located in ssMD.F
13684 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13685 'evdw',i,j,evdwij,'tss'
13686 endif!dyn_ss_mask(k)
13689 ! if (energy_dec) write (iout,*) &
13690 ! 'evdw',i,j,evdwij,' ss'
13694 if (itypj.eq.ntyp1) cycle
13695 ! dscj_inv=dsc_inv(itypj)
13696 dscj_inv=vbld_inv(j+nres)
13697 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13698 ! & 1.0d0/vbld(j+nres)
13699 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13700 sig0ij=sigma(itypi,itypj)
13701 chi1=chi(itypi,itypj)
13702 chi2=chi(itypj,itypi)
13709 alf12=0.5D0*(alf1+alf2)
13710 ! xj=c(1,nres+j)-xi
13711 ! yj=c(2,nres+j)-yi
13712 ! zj=c(3,nres+j)-zi
13716 ! Searching for nearest neighbour
13717 xj=mod(xj,boxxsize)
13718 if (xj.lt.0) xj=xj+boxxsize
13719 yj=mod(yj,boxysize)
13720 if (yj.lt.0) yj=yj+boxysize
13721 zj=mod(zj,boxzsize)
13722 if (zj.lt.0) zj=zj+boxzsize
13723 if ((zj.gt.bordlipbot) &
13724 .and.(zj.lt.bordliptop)) then
13725 !C the energy transfer exist
13726 if (zj.lt.buflipbot) then
13727 !C what fraction I am in
13729 ((zj-bordlipbot)/lipbufthick)
13730 !C lipbufthick is thickenes of lipid buffore
13731 sslipj=sscalelip(fracinbuf)
13732 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13733 elseif (zj.gt.bufliptop) then
13734 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13735 sslipj=sscalelip(fracinbuf)
13736 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13745 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13746 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13747 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13748 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13750 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13759 xj=xj_safe+xshift*boxxsize
13760 yj=yj_safe+yshift*boxysize
13761 zj=zj_safe+zshift*boxzsize
13762 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13763 if(dist_temp.lt.dist_init) then
13764 dist_init=dist_temp
13773 if (subchap.eq.1) then
13783 dxj=dc_norm(1,nres+j)
13784 dyj=dc_norm(2,nres+j)
13785 dzj=dc_norm(3,nres+j)
13786 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13788 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13789 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13790 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13791 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13792 if (sss_ele_cut.le.0.0) cycle
13794 if (sss.gt.0.0d0) then
13796 ! Calculate angle-dependent terms of energy and contributions to their
13800 sig=sig0ij*dsqrt(sigsq)
13801 rij_shift=1.0D0/rij-sig+sig0ij
13802 ! for diagnostics; uncomment
13803 ! rij_shift=1.2*sig0ij
13804 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13805 if (rij_shift.le.0.0D0) then
13807 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13808 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13809 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13813 !---------------------------------------------------------------
13814 rij_shift=1.0D0/rij_shift
13815 fac=rij_shift**expon
13818 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13819 eps2der=evdwij*eps3rt
13820 eps3der=evdwij*eps2rt
13821 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13822 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13823 evdwij=evdwij*eps2rt*eps3rt
13824 evdw=evdw+evdwij*sss*sss_ele_cut
13826 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13827 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13828 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13829 restyp(itypi,1),i,restyp(itypj,1),j,&
13830 epsi,sigm,chi1,chi2,chip1,chip2,&
13831 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13832 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13836 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13838 ! if (energy_dec) write (iout,*) &
13839 ! 'evdw',i,j,evdwij,"egb_short"
13841 ! Calculate gradient components.
13842 e1=e1*eps1*eps2rt**2*eps3rt**2
13843 fac=-expon*(e1+evdwij)*rij_shift
13846 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13847 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13848 /sigmaii(itypi,itypj))
13851 ! Calculate the radial part of the gradient
13855 ! Calculate angular part of the gradient.
13856 call sc_grad_scale(sss)
13862 ! write (iout,*) "Number of loop steps in EGB:",ind
13863 !ccc energy_dec=.false.
13865 end subroutine egb_short
13866 !-----------------------------------------------------------------------------
13867 subroutine egbv_long(evdw)
13869 ! This subroutine calculates the interaction energy of nonbonded side chains
13870 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13873 ! implicit real*8 (a-h,o-z)
13874 ! include 'DIMENSIONS'
13875 ! include 'COMMON.GEO'
13876 ! include 'COMMON.VAR'
13877 ! include 'COMMON.LOCAL'
13878 ! include 'COMMON.CHAIN'
13879 ! include 'COMMON.DERIV'
13880 ! include 'COMMON.NAMES'
13881 ! include 'COMMON.INTERACT'
13882 ! include 'COMMON.IOUNITS'
13883 ! include 'COMMON.CALC'
13885 !el integer :: icall
13886 !el common /srutu/ icall
13888 !el local variables
13889 integer :: iint,itypi,itypi1,itypj
13890 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13891 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13893 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13896 ! if (icall.eq.0) lprn=.true.
13898 do i=iatsc_s,iatsc_e
13900 if (itypi.eq.ntyp1) cycle
13901 itypi1=itype(i+1,1)
13905 dxi=dc_norm(1,nres+i)
13906 dyi=dc_norm(2,nres+i)
13907 dzi=dc_norm(3,nres+i)
13908 ! dsci_inv=dsc_inv(itypi)
13909 dsci_inv=vbld_inv(i+nres)
13911 ! Calculate SC interaction energy.
13913 do iint=1,nint_gr(i)
13914 do j=istart(i,iint),iend(i,iint)
13917 if (itypj.eq.ntyp1) cycle
13918 ! dscj_inv=dsc_inv(itypj)
13919 dscj_inv=vbld_inv(j+nres)
13920 sig0ij=sigma(itypi,itypj)
13921 r0ij=r0(itypi,itypj)
13922 chi1=chi(itypi,itypj)
13923 chi2=chi(itypj,itypi)
13930 alf12=0.5D0*(alf1+alf2)
13934 dxj=dc_norm(1,nres+j)
13935 dyj=dc_norm(2,nres+j)
13936 dzj=dc_norm(3,nres+j)
13937 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13940 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13942 if (sss.lt.1.0d0) then
13944 ! Calculate angle-dependent terms of energy and contributions to their
13948 sig=sig0ij*dsqrt(sigsq)
13949 rij_shift=1.0D0/rij-sig+r0ij
13950 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13951 if (rij_shift.le.0.0D0) then
13956 !---------------------------------------------------------------
13957 rij_shift=1.0D0/rij_shift
13958 fac=rij_shift**expon
13959 e1=fac*fac*aa_aq(itypi,itypj)
13960 e2=fac*bb_aq(itypi,itypj)
13961 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13962 eps2der=evdwij*eps3rt
13963 eps3der=evdwij*eps2rt
13964 fac_augm=rrij**expon
13965 e_augm=augm(itypi,itypj)*fac_augm
13966 evdwij=evdwij*eps2rt*eps3rt
13967 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13969 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13970 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13971 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13972 restyp(itypi,1),i,restyp(itypj,1),j,&
13973 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13974 chi1,chi2,chip1,chip2,&
13975 eps1,eps2rt**2,eps3rt**2,&
13976 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13979 ! Calculate gradient components.
13980 e1=e1*eps1*eps2rt**2*eps3rt**2
13981 fac=-expon*(e1+evdwij)*rij_shift
13983 fac=rij*fac-2*expon*rrij*e_augm
13984 ! Calculate the radial part of the gradient
13988 ! Calculate angular part of the gradient.
13989 call sc_grad_scale(1.0d0-sss)
13994 end subroutine egbv_long
13995 !-----------------------------------------------------------------------------
13996 subroutine egbv_short(evdw)
13998 ! This subroutine calculates the interaction energy of nonbonded side chains
13999 ! assuming the Gay-Berne-Vorobjev potential of interaction.
14002 ! implicit real*8 (a-h,o-z)
14003 ! include 'DIMENSIONS'
14004 ! include 'COMMON.GEO'
14005 ! include 'COMMON.VAR'
14006 ! include 'COMMON.LOCAL'
14007 ! include 'COMMON.CHAIN'
14008 ! include 'COMMON.DERIV'
14009 ! include 'COMMON.NAMES'
14010 ! include 'COMMON.INTERACT'
14011 ! include 'COMMON.IOUNITS'
14012 ! include 'COMMON.CALC'
14014 !el integer :: icall
14015 !el common /srutu/ icall
14017 !el local variables
14018 integer :: iint,itypi,itypi1,itypj
14019 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
14020 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
14022 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14025 ! if (icall.eq.0) lprn=.true.
14027 do i=iatsc_s,iatsc_e
14029 if (itypi.eq.ntyp1) cycle
14030 itypi1=itype(i+1,1)
14034 dxi=dc_norm(1,nres+i)
14035 dyi=dc_norm(2,nres+i)
14036 dzi=dc_norm(3,nres+i)
14037 ! dsci_inv=dsc_inv(itypi)
14038 dsci_inv=vbld_inv(i+nres)
14040 ! Calculate SC interaction energy.
14042 do iint=1,nint_gr(i)
14043 do j=istart(i,iint),iend(i,iint)
14046 if (itypj.eq.ntyp1) cycle
14047 ! dscj_inv=dsc_inv(itypj)
14048 dscj_inv=vbld_inv(j+nres)
14049 sig0ij=sigma(itypi,itypj)
14050 r0ij=r0(itypi,itypj)
14051 chi1=chi(itypi,itypj)
14052 chi2=chi(itypj,itypi)
14059 alf12=0.5D0*(alf1+alf2)
14063 dxj=dc_norm(1,nres+j)
14064 dyj=dc_norm(2,nres+j)
14065 dzj=dc_norm(3,nres+j)
14066 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14069 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14071 if (sss.gt.0.0d0) then
14073 ! Calculate angle-dependent terms of energy and contributions to their
14077 sig=sig0ij*dsqrt(sigsq)
14078 rij_shift=1.0D0/rij-sig+r0ij
14079 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14080 if (rij_shift.le.0.0D0) then
14085 !---------------------------------------------------------------
14086 rij_shift=1.0D0/rij_shift
14087 fac=rij_shift**expon
14088 e1=fac*fac*aa_aq(itypi,itypj)
14089 e2=fac*bb_aq(itypi,itypj)
14090 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14091 eps2der=evdwij*eps3rt
14092 eps3der=evdwij*eps2rt
14093 fac_augm=rrij**expon
14094 e_augm=augm(itypi,itypj)*fac_augm
14095 evdwij=evdwij*eps2rt*eps3rt
14096 evdw=evdw+(evdwij+e_augm)*sss
14098 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14099 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14100 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14101 restyp(itypi,1),i,restyp(itypj,1),j,&
14102 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
14103 chi1,chi2,chip1,chip2,&
14104 eps1,eps2rt**2,eps3rt**2,&
14105 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14108 ! Calculate gradient components.
14109 e1=e1*eps1*eps2rt**2*eps3rt**2
14110 fac=-expon*(e1+evdwij)*rij_shift
14112 fac=rij*fac-2*expon*rrij*e_augm
14113 ! Calculate the radial part of the gradient
14117 ! Calculate angular part of the gradient.
14118 call sc_grad_scale(sss)
14123 end subroutine egbv_short
14124 !-----------------------------------------------------------------------------
14125 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
14127 ! This subroutine calculates the average interaction energy and its gradient
14128 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
14129 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
14130 ! The potential depends both on the distance of peptide-group centers and on
14131 ! the orientation of the CA-CA virtual bonds.
14133 ! implicit real*8 (a-h,o-z)
14139 ! include 'DIMENSIONS'
14140 ! include 'COMMON.CONTROL'
14141 ! include 'COMMON.SETUP'
14142 ! include 'COMMON.IOUNITS'
14143 ! include 'COMMON.GEO'
14144 ! include 'COMMON.VAR'
14145 ! include 'COMMON.LOCAL'
14146 ! include 'COMMON.CHAIN'
14147 ! include 'COMMON.DERIV'
14148 ! include 'COMMON.INTERACT'
14149 ! include 'COMMON.CONTACTS'
14150 ! include 'COMMON.TORSION'
14151 ! include 'COMMON.VECTORS'
14152 ! include 'COMMON.FFIELD'
14153 ! include 'COMMON.TIME1'
14154 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
14155 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
14156 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14157 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14158 real(kind=8),dimension(4) :: muij
14159 !el integer :: num_conti,j1,j2
14160 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14161 !el dz_normi,xmedi,ymedi,zmedi
14162 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14163 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14164 !el num_conti,j1,j2
14165 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14167 real(kind=8) :: scal_el=1.0d0
14169 real(kind=8) :: scal_el=0.5d0
14172 ! 13-go grudnia roku pamietnego...
14173 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14174 0.0d0,1.0d0,0.0d0,&
14175 0.0d0,0.0d0,1.0d0/),shape(unmat))
14176 !el local variables
14178 real(kind=8) :: fac
14179 real(kind=8) :: dxj,dyj,dzj
14180 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
14182 ! allocate(num_cont_hb(nres)) !(maxres)
14183 !d write(iout,*) 'In EELEC'
14185 !d write(iout,*) 'Type',i
14186 !d write(iout,*) 'B1',B1(:,i)
14187 !d write(iout,*) 'B2',B2(:,i)
14188 !d write(iout,*) 'CC',CC(:,:,i)
14189 !d write(iout,*) 'DD',DD(:,:,i)
14190 !d write(iout,*) 'EE',EE(:,:,i)
14192 !d call check_vecgrad
14194 if (icheckgrad.eq.1) then
14196 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
14198 dc_norm(k,i)=dc(k,i)*fac
14200 ! write (iout,*) 'i',i,' fac',fac
14203 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14204 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
14205 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
14206 ! call vec_and_deriv
14210 ! print *, "before set matrices"
14212 ! print *,"after set martices"
14214 time_mat=time_mat+MPI_Wtime()-time01
14218 !d write (iout,*) 'i=',i
14220 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
14223 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
14224 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
14237 !d print '(a)','Enter EELEC'
14238 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
14239 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14240 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14242 gel_loc_loc(i)=0.0d0
14247 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
14249 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
14251 do i=iturn3_start,iturn3_end
14252 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
14253 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
14257 dx_normi=dc_norm(1,i)
14258 dy_normi=dc_norm(2,i)
14259 dz_normi=dc_norm(3,i)
14260 xmedi=c(1,i)+0.5d0*dxi
14261 ymedi=c(2,i)+0.5d0*dyi
14262 zmedi=c(3,i)+0.5d0*dzi
14263 xmedi=dmod(xmedi,boxxsize)
14264 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14265 ymedi=dmod(ymedi,boxysize)
14266 if (ymedi.lt.0) ymedi=ymedi+boxysize
14267 zmedi=dmod(zmedi,boxzsize)
14268 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14270 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
14271 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
14272 num_cont_hb(i)=num_conti
14274 do i=iturn4_start,iturn4_end
14275 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
14276 .or. itype(i+3,1).eq.ntyp1 &
14277 .or. itype(i+4,1).eq.ntyp1) cycle
14281 dx_normi=dc_norm(1,i)
14282 dy_normi=dc_norm(2,i)
14283 dz_normi=dc_norm(3,i)
14284 xmedi=c(1,i)+0.5d0*dxi
14285 ymedi=c(2,i)+0.5d0*dyi
14286 zmedi=c(3,i)+0.5d0*dzi
14287 xmedi=dmod(xmedi,boxxsize)
14288 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14289 ymedi=dmod(ymedi,boxysize)
14290 if (ymedi.lt.0) ymedi=ymedi+boxysize
14291 zmedi=dmod(zmedi,boxzsize)
14292 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14293 num_conti=num_cont_hb(i)
14294 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
14295 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
14296 call eturn4(i,eello_turn4)
14297 num_cont_hb(i)=num_conti
14300 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
14302 do i=iatel_s,iatel_e
14303 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14307 dx_normi=dc_norm(1,i)
14308 dy_normi=dc_norm(2,i)
14309 dz_normi=dc_norm(3,i)
14310 xmedi=c(1,i)+0.5d0*dxi
14311 ymedi=c(2,i)+0.5d0*dyi
14312 zmedi=c(3,i)+0.5d0*dzi
14313 xmedi=dmod(xmedi,boxxsize)
14314 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14315 ymedi=dmod(ymedi,boxysize)
14316 if (ymedi.lt.0) ymedi=ymedi+boxysize
14317 zmedi=dmod(zmedi,boxzsize)
14318 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14319 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14320 num_conti=num_cont_hb(i)
14321 do j=ielstart(i),ielend(i)
14322 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14323 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14325 num_cont_hb(i)=num_conti
14327 ! write (iout,*) "Number of loop steps in EELEC:",ind
14329 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14330 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14332 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14333 !cc eel_loc=eel_loc+eello_turn3
14334 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14336 end subroutine eelec_scale
14337 !-----------------------------------------------------------------------------
14338 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14339 ! implicit real*8 (a-h,o-z)
14342 ! include 'DIMENSIONS'
14346 ! include 'COMMON.CONTROL'
14347 ! include 'COMMON.IOUNITS'
14348 ! include 'COMMON.GEO'
14349 ! include 'COMMON.VAR'
14350 ! include 'COMMON.LOCAL'
14351 ! include 'COMMON.CHAIN'
14352 ! include 'COMMON.DERIV'
14353 ! include 'COMMON.INTERACT'
14354 ! include 'COMMON.CONTACTS'
14355 ! include 'COMMON.TORSION'
14356 ! include 'COMMON.VECTORS'
14357 ! include 'COMMON.FFIELD'
14358 ! include 'COMMON.TIME1'
14359 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14360 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14361 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14362 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14363 real(kind=8),dimension(4) :: muij
14364 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14365 dist_temp, dist_init,sss_grad
14366 integer xshift,yshift,zshift
14368 !el integer :: num_conti,j1,j2
14369 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14370 !el dz_normi,xmedi,ymedi,zmedi
14371 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14372 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14373 !el num_conti,j1,j2
14374 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14376 real(kind=8) :: scal_el=1.0d0
14378 real(kind=8) :: scal_el=0.5d0
14381 ! 13-go grudnia roku pamietnego...
14382 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14383 0.0d0,1.0d0,0.0d0,&
14384 0.0d0,0.0d0,1.0d0/),shape(unmat))
14385 !el local variables
14386 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
14387 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
14388 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
14389 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
14390 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
14391 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
14392 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
14393 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
14394 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
14395 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
14396 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
14397 ecosam,ecosbm,ecosgm,ghalf,time00
14398 ! integer :: maxconts
14399 ! maxconts = nres/4
14400 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14401 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14402 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14403 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14404 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14405 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14406 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14407 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14408 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
14409 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
14410 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
14411 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
14412 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
14414 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
14415 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
14420 !d write (iout,*) "eelecij",i,j
14424 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14425 aaa=app(iteli,itelj)
14426 bbb=bpp(iteli,itelj)
14427 ael6i=ael6(iteli,itelj)
14428 ael3i=ael3(iteli,itelj)
14432 dx_normj=dc_norm(1,j)
14433 dy_normj=dc_norm(2,j)
14434 dz_normj=dc_norm(3,j)
14435 ! xj=c(1,j)+0.5D0*dxj-xmedi
14436 ! yj=c(2,j)+0.5D0*dyj-ymedi
14437 ! zj=c(3,j)+0.5D0*dzj-zmedi
14438 xj=c(1,j)+0.5D0*dxj
14439 yj=c(2,j)+0.5D0*dyj
14440 zj=c(3,j)+0.5D0*dzj
14441 xj=mod(xj,boxxsize)
14442 if (xj.lt.0) xj=xj+boxxsize
14443 yj=mod(yj,boxysize)
14444 if (yj.lt.0) yj=yj+boxysize
14445 zj=mod(zj,boxzsize)
14446 if (zj.lt.0) zj=zj+boxzsize
14448 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14455 xj=xj_safe+xshift*boxxsize
14456 yj=yj_safe+yshift*boxysize
14457 zj=zj_safe+zshift*boxzsize
14458 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14459 if(dist_temp.lt.dist_init) then
14460 dist_init=dist_temp
14469 if (isubchap.eq.1) then
14480 rij=xj*xj+yj*yj+zj*zj
14484 ! For extracting the short-range part of Evdwpp
14485 sss=sscale(rij/rpp(iteli,itelj))
14486 sss_ele_cut=sscale_ele(rij)
14487 sss_ele_grad=sscagrad_ele(rij)
14488 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14489 ! sss_ele_cut=1.0d0
14490 ! sss_ele_grad=0.0d0
14491 if (sss_ele_cut.le.0.0) go to 128
14495 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
14496 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
14497 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
14498 fac=cosa-3.0D0*cosb*cosg
14500 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14501 if (j.eq.i+2) ev1=scal_el*ev1
14506 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
14509 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
14510 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
14511 ees=ees+eesij*sss_ele_cut
14512 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
14513 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
14514 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
14515 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
14516 !d & xmedi,ymedi,zmedi,xj,yj,zj
14518 if (energy_dec) then
14519 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14520 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
14524 ! Calculate contributions to the Cartesian gradient.
14527 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14528 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14534 ! Radial derivatives. First process both termini of the fragment (i,j)
14536 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14537 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14538 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14540 ! ghalf=0.5D0*ggg(k)
14541 ! gelc(k,i)=gelc(k,i)+ghalf
14542 ! gelc(k,j)=gelc(k,j)+ghalf
14544 ! 9/28/08 AL Gradient compotents will be summed only at the end
14546 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14547 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14550 ! Loop over residues i+1 thru j-1.
14554 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14557 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14558 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14559 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14560 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14561 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14562 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14564 ! ghalf=0.5D0*ggg(k)
14565 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14566 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14568 ! 9/28/08 AL Gradient compotents will be summed only at the end
14570 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14571 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14574 ! Loop over residues i+1 thru j-1.
14578 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14582 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14583 facel=(el1+eesij)*sss_ele_cut
14585 fac=-3*rrmij*(facvdw+facvdw+facel)
14590 ! Radial derivatives. First process both termini of the fragment (i,j)
14596 ! ghalf=0.5D0*ggg(k)
14597 ! gelc(k,i)=gelc(k,i)+ghalf
14598 ! gelc(k,j)=gelc(k,j)+ghalf
14600 ! 9/28/08 AL Gradient compotents will be summed only at the end
14602 gelc_long(k,j)=gelc(k,j)+ggg(k)
14603 gelc_long(k,i)=gelc(k,i)-ggg(k)
14606 ! Loop over residues i+1 thru j-1.
14610 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14613 ! 9/28/08 AL Gradient compotents will be summed only at the end
14618 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14619 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14625 ecosa=2.0D0*fac3*fac1+fac4
14628 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14629 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14631 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14632 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14634 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
14635 !d & (dcosg(k),k=1,3)
14637 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
14640 ! ghalf=0.5D0*ggg(k)
14641 ! gelc(k,i)=gelc(k,i)+ghalf
14642 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
14643 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14644 ! gelc(k,j)=gelc(k,j)+ghalf
14645 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
14646 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14650 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14654 gelc(k,i)=gelc(k,i) &
14655 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14656 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
14658 gelc(k,j)=gelc(k,j) &
14659 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14660 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14662 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14663 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14665 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14666 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
14667 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14669 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
14670 ! energy of a peptide unit is assumed in the form of a second-order
14671 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
14672 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
14673 ! are computed for EVERY pair of non-contiguous peptide groups.
14675 if (j.lt.nres-1) then
14686 muij(kkk)=mu(k,i)*mu(l,j)
14689 !d write (iout,*) 'EELEC: i',i,' j',j
14690 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
14691 !d write(iout,*) 'muij',muij
14692 ury=scalar(uy(1,i),erij)
14693 urz=scalar(uz(1,i),erij)
14694 vry=scalar(uy(1,j),erij)
14695 vrz=scalar(uz(1,j),erij)
14696 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
14697 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
14698 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
14699 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
14700 fac=dsqrt(-ael6i)*r3ij
14705 !d write (iout,'(4i5,4f10.5)')
14706 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
14707 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
14708 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
14709 !d & uy(:,j),uz(:,j)
14710 !d write (iout,'(4f10.5)')
14711 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
14712 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14713 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14714 !d write (iout,'(9f10.5/)')
14715 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14716 ! Derivatives of the elements of A in virtual-bond vectors
14717 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14719 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14720 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14721 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14722 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14723 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14724 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14725 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14726 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14727 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14728 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14729 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14730 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14732 ! Compute radial contributions to the gradient
14750 ! Add the contributions coming from er
14753 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14754 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14755 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14756 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14759 ! Derivatives in DC(i)
14760 !grad ghalf1=0.5d0*agg(k,1)
14761 !grad ghalf2=0.5d0*agg(k,2)
14762 !grad ghalf3=0.5d0*agg(k,3)
14763 !grad ghalf4=0.5d0*agg(k,4)
14764 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14765 -3.0d0*uryg(k,2)*vry)!+ghalf1
14766 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14767 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14768 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14769 -3.0d0*urzg(k,2)*vry)!+ghalf3
14770 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14771 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14772 ! Derivatives in DC(i+1)
14773 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14774 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14775 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14776 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14777 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14778 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14779 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14780 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14781 ! Derivatives in DC(j)
14782 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14783 -3.0d0*vryg(k,2)*ury)!+ghalf1
14784 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14785 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14786 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14787 -3.0d0*vryg(k,2)*urz)!+ghalf3
14788 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14789 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14790 ! Derivatives in DC(j+1) or DC(nres-1)
14791 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14792 -3.0d0*vryg(k,3)*ury)
14793 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14794 -3.0d0*vrzg(k,3)*ury)
14795 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14796 -3.0d0*vryg(k,3)*urz)
14797 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14798 -3.0d0*vrzg(k,3)*urz)
14799 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14801 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14814 aggi(k,l)=-aggi(k,l)
14815 aggi1(k,l)=-aggi1(k,l)
14816 aggj(k,l)=-aggj(k,l)
14817 aggj1(k,l)=-aggj1(k,l)
14820 if (j.lt.nres-1) then
14826 aggi(k,l)=-aggi(k,l)
14827 aggi1(k,l)=-aggi1(k,l)
14828 aggj(k,l)=-aggj(k,l)
14829 aggj1(k,l)=-aggj1(k,l)
14840 aggi(k,l)=-aggi(k,l)
14841 aggi1(k,l)=-aggi1(k,l)
14842 aggj(k,l)=-aggj(k,l)
14843 aggj1(k,l)=-aggj1(k,l)
14848 IF (wel_loc.gt.0.0d0) THEN
14849 ! Contribution to the local-electrostatic energy coming from the i-j pair
14850 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14852 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14853 ! print *,"EELLOC",i,gel_loc_loc(i-1)
14854 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14855 'eelloc',i,j,eel_loc_ij
14856 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14858 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14859 ! Partial derivatives in virtual-bond dihedral angles gamma
14861 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14862 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14863 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14865 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14866 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14867 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14873 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14875 ggg(l)=(agg(l,1)*muij(1)+ &
14876 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14878 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14880 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14881 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14882 !grad ghalf=0.5d0*ggg(l)
14883 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14884 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14888 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14891 ! Remaining derivatives of eello
14893 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14894 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14897 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14898 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14901 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14902 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14905 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14906 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14911 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14912 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14913 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14914 .and. num_conti.le.maxconts) then
14915 ! write (iout,*) i,j," entered corr"
14917 ! Calculate the contact function. The ith column of the array JCONT will
14918 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14919 ! greater than I). The arrays FACONT and GACONT will contain the values of
14920 ! the contact function and its derivative.
14921 ! r0ij=1.02D0*rpp(iteli,itelj)
14922 ! r0ij=1.11D0*rpp(iteli,itelj)
14923 r0ij=2.20D0*rpp(iteli,itelj)
14924 ! r0ij=1.55D0*rpp(iteli,itelj)
14925 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14926 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14927 if (fcont.gt.0.0D0) then
14928 num_conti=num_conti+1
14929 if (num_conti.gt.maxconts) then
14930 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14931 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14932 ' will skip next contacts for this conf.',num_conti
14934 jcont_hb(num_conti,i)=j
14935 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14936 !d & " jcont_hb",jcont_hb(num_conti,i)
14937 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14938 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14939 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14941 d_cont(num_conti,i)=rij
14942 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14943 ! --- Electrostatic-interaction matrix ---
14944 a_chuj(1,1,num_conti,i)=a22
14945 a_chuj(1,2,num_conti,i)=a23
14946 a_chuj(2,1,num_conti,i)=a32
14947 a_chuj(2,2,num_conti,i)=a33
14948 ! --- Gradient of rij
14950 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14957 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14958 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14959 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14960 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14961 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14966 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14967 ! Calculate contact energies
14969 wij=cosa-3.0D0*cosb*cosg
14972 ! fac3=dsqrt(-ael6i)/r0ij**3
14973 fac3=dsqrt(-ael6i)*r3ij
14974 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14975 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14976 if (ees0tmp.gt.0) then
14977 ees0pij=dsqrt(ees0tmp)
14981 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14982 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14983 if (ees0tmp.gt.0) then
14984 ees0mij=dsqrt(ees0tmp)
14989 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14992 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14995 ! Diagnostics. Comment out or remove after debugging!
14996 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14997 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14998 ! ees0m(num_conti,i)=0.0D0
15000 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
15001 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
15002 ! Angular derivatives of the contact function
15003 ees0pij1=fac3/ees0pij
15004 ees0mij1=fac3/ees0mij
15005 fac3p=-3.0D0*fac3*rrmij
15006 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
15007 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
15009 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
15010 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
15011 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
15012 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
15013 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
15014 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
15015 ecosap=ecosa1+ecosa2
15016 ecosbp=ecosb1+ecosb2
15017 ecosgp=ecosg1+ecosg2
15018 ecosam=ecosa1-ecosa2
15019 ecosbm=ecosb1-ecosb2
15020 ecosgm=ecosg1-ecosg2
15029 facont_hb(num_conti,i)=fcont
15030 fprimcont=fprimcont/rij
15031 !d facont_hb(num_conti,i)=1.0D0
15032 ! Following line is for diagnostics.
15035 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
15036 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
15039 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
15040 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
15042 ! gggp(1)=gggp(1)+ees0pijp*xj
15043 ! gggp(2)=gggp(2)+ees0pijp*yj
15044 ! gggp(3)=gggp(3)+ees0pijp*zj
15045 ! gggm(1)=gggm(1)+ees0mijp*xj
15046 ! gggm(2)=gggm(2)+ees0mijp*yj
15047 ! gggm(3)=gggm(3)+ees0mijp*zj
15048 gggp(1)=gggp(1)+ees0pijp*xj &
15049 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
15050 gggp(2)=gggp(2)+ees0pijp*yj &
15051 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
15052 gggp(3)=gggp(3)+ees0pijp*zj &
15053 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
15055 gggm(1)=gggm(1)+ees0mijp*xj &
15056 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
15058 gggm(2)=gggm(2)+ees0mijp*yj &
15059 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
15061 gggm(3)=gggm(3)+ees0mijp*zj &
15062 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
15064 ! Derivatives due to the contact function
15065 gacont_hbr(1,num_conti,i)=fprimcont*xj
15066 gacont_hbr(2,num_conti,i)=fprimcont*yj
15067 gacont_hbr(3,num_conti,i)=fprimcont*zj
15070 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
15071 ! following the change of gradient-summation algorithm.
15073 !grad ghalfp=0.5D0*gggp(k)
15074 !grad ghalfm=0.5D0*gggm(k)
15075 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
15076 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15077 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15078 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
15079 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15080 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15081 ! gacontp_hb3(k,num_conti,i)=gggp(k)
15082 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
15083 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15084 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15085 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
15086 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15087 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15088 ! gacontm_hb3(k,num_conti,i)=gggm(k)
15089 gacontp_hb1(k,num_conti,i)= & !ghalfp+
15090 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15091 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
15094 gacontp_hb2(k,num_conti,i)= & !ghalfp+
15095 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15096 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
15099 gacontp_hb3(k,num_conti,i)=gggp(k) &
15102 gacontm_hb1(k,num_conti,i)= & !ghalfm+
15103 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15104 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
15107 gacontm_hb2(k,num_conti,i)= & !ghalfm+
15108 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15109 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
15112 gacontm_hb3(k,num_conti,i)=gggm(k) &
15117 endif ! num_conti.le.maxconts
15120 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
15123 ghalf=0.5d0*agg(l,k)
15124 aggi(l,k)=aggi(l,k)+ghalf
15125 aggi1(l,k)=aggi1(l,k)+agg(l,k)
15126 aggj(l,k)=aggj(l,k)+ghalf
15129 if (j.eq.nres-1 .and. i.lt.j-2) then
15132 aggj1(l,k)=aggj1(l,k)+agg(l,k)
15138 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
15140 end subroutine eelecij_scale
15141 !-----------------------------------------------------------------------------
15142 subroutine evdwpp_short(evdw1)
15146 ! implicit real*8 (a-h,o-z)
15147 ! include 'DIMENSIONS'
15148 ! include 'COMMON.CONTROL'
15149 ! include 'COMMON.IOUNITS'
15150 ! include 'COMMON.GEO'
15151 ! include 'COMMON.VAR'
15152 ! include 'COMMON.LOCAL'
15153 ! include 'COMMON.CHAIN'
15154 ! include 'COMMON.DERIV'
15155 ! include 'COMMON.INTERACT'
15156 ! include 'COMMON.CONTACTS'
15157 ! include 'COMMON.TORSION'
15158 ! include 'COMMON.VECTORS'
15159 ! include 'COMMON.FFIELD'
15160 real(kind=8),dimension(3) :: ggg
15161 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
15163 real(kind=8) :: scal_el=1.0d0
15165 real(kind=8) :: scal_el=0.5d0
15167 !el local variables
15168 integer :: i,j,k,iteli,itelj,num_conti,isubchap
15169 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
15170 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
15171 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
15172 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
15173 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15174 dist_temp, dist_init,sss_grad
15175 integer xshift,yshift,zshift
15179 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
15180 ! & " iatel_e_vdw",iatel_e_vdw
15182 do i=iatel_s_vdw,iatel_e_vdw
15183 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
15187 dx_normi=dc_norm(1,i)
15188 dy_normi=dc_norm(2,i)
15189 dz_normi=dc_norm(3,i)
15190 xmedi=c(1,i)+0.5d0*dxi
15191 ymedi=c(2,i)+0.5d0*dyi
15192 zmedi=c(3,i)+0.5d0*dzi
15193 xmedi=dmod(xmedi,boxxsize)
15194 if (xmedi.lt.0) xmedi=xmedi+boxxsize
15195 ymedi=dmod(ymedi,boxysize)
15196 if (ymedi.lt.0) ymedi=ymedi+boxysize
15197 zmedi=dmod(zmedi,boxzsize)
15198 if (zmedi.lt.0) zmedi=zmedi+boxzsize
15200 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
15201 ! & ' ielend',ielend_vdw(i)
15203 do j=ielstart_vdw(i),ielend_vdw(i)
15204 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
15208 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
15209 aaa=app(iteli,itelj)
15210 bbb=bpp(iteli,itelj)
15214 dx_normj=dc_norm(1,j)
15215 dy_normj=dc_norm(2,j)
15216 dz_normj=dc_norm(3,j)
15217 ! xj=c(1,j)+0.5D0*dxj-xmedi
15218 ! yj=c(2,j)+0.5D0*dyj-ymedi
15219 ! zj=c(3,j)+0.5D0*dzj-zmedi
15220 xj=c(1,j)+0.5D0*dxj
15221 yj=c(2,j)+0.5D0*dyj
15222 zj=c(3,j)+0.5D0*dzj
15223 xj=mod(xj,boxxsize)
15224 if (xj.lt.0) xj=xj+boxxsize
15225 yj=mod(yj,boxysize)
15226 if (yj.lt.0) yj=yj+boxysize
15227 zj=mod(zj,boxzsize)
15228 if (zj.lt.0) zj=zj+boxzsize
15230 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15237 xj=xj_safe+xshift*boxxsize
15238 yj=yj_safe+yshift*boxysize
15239 zj=zj_safe+zshift*boxzsize
15240 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15241 if(dist_temp.lt.dist_init) then
15242 dist_init=dist_temp
15251 if (isubchap.eq.1) then
15262 rij=xj*xj+yj*yj+zj*zj
15265 sss=sscale(rij/rpp(iteli,itelj))
15266 sss_ele_cut=sscale_ele(rij)
15267 sss_ele_grad=sscagrad_ele(rij)
15268 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15269 if (sss_ele_cut.le.0.0) cycle
15270 if (sss.gt.0.0d0) then
15275 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15276 if (j.eq.i+2) ev1=scal_el*ev1
15279 if (energy_dec) then
15280 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15282 evdw1=evdw1+evdwij*sss*sss_ele_cut
15284 ! Calculate contributions to the Cartesian gradient.
15286 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
15290 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
15291 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15292 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
15293 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15294 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
15295 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15298 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15299 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15305 end subroutine evdwpp_short
15306 !-----------------------------------------------------------------------------
15307 subroutine escp_long(evdw2,evdw2_14)
15309 ! This subroutine calculates the excluded-volume interaction energy between
15310 ! peptide-group centers and side chains and its gradient in virtual-bond and
15311 ! side-chain vectors.
15313 ! implicit real*8 (a-h,o-z)
15314 ! include 'DIMENSIONS'
15315 ! include 'COMMON.GEO'
15316 ! include 'COMMON.VAR'
15317 ! include 'COMMON.LOCAL'
15318 ! include 'COMMON.CHAIN'
15319 ! include 'COMMON.DERIV'
15320 ! include 'COMMON.INTERACT'
15321 ! include 'COMMON.FFIELD'
15322 ! include 'COMMON.IOUNITS'
15323 ! include 'COMMON.CONTROL'
15324 real(kind=8),dimension(3) :: ggg
15325 !el local variables
15326 integer :: i,iint,j,k,iteli,itypj,subchap
15327 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15328 real(kind=8) :: evdw2,evdw2_14,evdwij
15329 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15330 dist_temp, dist_init
15334 !d print '(a)','Enter ESCP'
15335 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15336 do i=iatscp_s,iatscp_e
15337 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15339 xi=0.5D0*(c(1,i)+c(1,i+1))
15340 yi=0.5D0*(c(2,i)+c(2,i+1))
15341 zi=0.5D0*(c(3,i)+c(3,i+1))
15342 xi=mod(xi,boxxsize)
15343 if (xi.lt.0) xi=xi+boxxsize
15344 yi=mod(yi,boxysize)
15345 if (yi.lt.0) yi=yi+boxysize
15346 zi=mod(zi,boxzsize)
15347 if (zi.lt.0) zi=zi+boxzsize
15349 do iint=1,nscp_gr(i)
15351 do j=iscpstart(i,iint),iscpend(i,iint)
15353 if (itypj.eq.ntyp1) cycle
15354 ! Uncomment following three lines for SC-p interactions
15355 ! xj=c(1,nres+j)-xi
15356 ! yj=c(2,nres+j)-yi
15357 ! zj=c(3,nres+j)-zi
15358 ! Uncomment following three lines for Ca-p interactions
15362 xj=mod(xj,boxxsize)
15363 if (xj.lt.0) xj=xj+boxxsize
15364 yj=mod(yj,boxysize)
15365 if (yj.lt.0) yj=yj+boxysize
15366 zj=mod(zj,boxzsize)
15367 if (zj.lt.0) zj=zj+boxzsize
15368 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15376 xj=xj_safe+xshift*boxxsize
15377 yj=yj_safe+yshift*boxysize
15378 zj=zj_safe+zshift*boxzsize
15379 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15380 if(dist_temp.lt.dist_init) then
15381 dist_init=dist_temp
15390 if (subchap.eq.1) then
15399 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15401 rij=dsqrt(1.0d0/rrij)
15402 sss_ele_cut=sscale_ele(rij)
15403 sss_ele_grad=sscagrad_ele(rij)
15404 ! print *,sss_ele_cut,sss_ele_grad,&
15405 ! (rij),r_cut_ele,rlamb_ele
15406 if (sss_ele_cut.le.0.0) cycle
15407 sss=sscale((rij/rscp(itypj,iteli)))
15408 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15409 if (sss.lt.1.0d0) then
15412 e1=fac*fac*aad(itypj,iteli)
15413 e2=fac*bad(itypj,iteli)
15414 if (iabs(j-i) .le. 2) then
15417 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
15420 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
15421 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15422 'evdw2',i,j,sss,evdwij
15424 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15426 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
15427 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
15428 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15432 ! Uncomment following three lines for SC-p interactions
15434 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15436 ! Uncomment following line for SC-p interactions
15437 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15439 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15440 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15449 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15450 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15451 gradx_scp(j,i)=expon*gradx_scp(j,i)
15454 !******************************************************************************
15458 ! To save time the factor EXPON has been extracted from ALL components
15459 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15462 !******************************************************************************
15464 end subroutine escp_long
15465 !-----------------------------------------------------------------------------
15466 subroutine escp_short(evdw2,evdw2_14)
15468 ! This subroutine calculates the excluded-volume interaction energy between
15469 ! peptide-group centers and side chains and its gradient in virtual-bond and
15470 ! side-chain vectors.
15472 ! implicit real*8 (a-h,o-z)
15473 ! include 'DIMENSIONS'
15474 ! include 'COMMON.GEO'
15475 ! include 'COMMON.VAR'
15476 ! include 'COMMON.LOCAL'
15477 ! include 'COMMON.CHAIN'
15478 ! include 'COMMON.DERIV'
15479 ! include 'COMMON.INTERACT'
15480 ! include 'COMMON.FFIELD'
15481 ! include 'COMMON.IOUNITS'
15482 ! include 'COMMON.CONTROL'
15483 real(kind=8),dimension(3) :: ggg
15484 !el local variables
15485 integer :: i,iint,j,k,iteli,itypj,subchap
15486 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15487 real(kind=8) :: evdw2,evdw2_14,evdwij
15488 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15489 dist_temp, dist_init
15493 !d print '(a)','Enter ESCP'
15494 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15495 do i=iatscp_s,iatscp_e
15496 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15498 xi=0.5D0*(c(1,i)+c(1,i+1))
15499 yi=0.5D0*(c(2,i)+c(2,i+1))
15500 zi=0.5D0*(c(3,i)+c(3,i+1))
15501 xi=mod(xi,boxxsize)
15502 if (xi.lt.0) xi=xi+boxxsize
15503 yi=mod(yi,boxysize)
15504 if (yi.lt.0) yi=yi+boxysize
15505 zi=mod(zi,boxzsize)
15506 if (zi.lt.0) zi=zi+boxzsize
15508 do iint=1,nscp_gr(i)
15510 do j=iscpstart(i,iint),iscpend(i,iint)
15512 if (itypj.eq.ntyp1) cycle
15513 ! Uncomment following three lines for SC-p interactions
15514 ! xj=c(1,nres+j)-xi
15515 ! yj=c(2,nres+j)-yi
15516 ! zj=c(3,nres+j)-zi
15517 ! Uncomment following three lines for Ca-p interactions
15524 xj=mod(xj,boxxsize)
15525 if (xj.lt.0) xj=xj+boxxsize
15526 yj=mod(yj,boxysize)
15527 if (yj.lt.0) yj=yj+boxysize
15528 zj=mod(zj,boxzsize)
15529 if (zj.lt.0) zj=zj+boxzsize
15530 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15538 xj=xj_safe+xshift*boxxsize
15539 yj=yj_safe+yshift*boxysize
15540 zj=zj_safe+zshift*boxzsize
15541 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15542 if(dist_temp.lt.dist_init) then
15543 dist_init=dist_temp
15552 if (subchap.eq.1) then
15562 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15563 rij=dsqrt(1.0d0/rrij)
15564 sss_ele_cut=sscale_ele(rij)
15565 sss_ele_grad=sscagrad_ele(rij)
15566 ! print *,sss_ele_cut,sss_ele_grad,&
15567 ! (rij),r_cut_ele,rlamb_ele
15568 if (sss_ele_cut.le.0.0) cycle
15569 sss=sscale(rij/rscp(itypj,iteli))
15570 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15571 if (sss.gt.0.0d0) then
15574 e1=fac*fac*aad(itypj,iteli)
15575 e2=fac*bad(itypj,iteli)
15576 if (iabs(j-i) .le. 2) then
15579 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15582 evdw2=evdw2+evdwij*sss*sss_ele_cut
15583 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15584 'evdw2',i,j,sss,evdwij
15586 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15588 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15589 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15590 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15595 ! Uncomment following three lines for SC-p interactions
15597 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15599 ! Uncomment following line for SC-p interactions
15600 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15602 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15603 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15612 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15613 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15614 gradx_scp(j,i)=expon*gradx_scp(j,i)
15617 !******************************************************************************
15621 ! To save time the factor EXPON has been extracted from ALL components
15622 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15625 !******************************************************************************
15627 end subroutine escp_short
15628 !-----------------------------------------------------------------------------
15629 ! energy_p_new-sep_barrier.F
15630 !-----------------------------------------------------------------------------
15631 subroutine sc_grad_scale(scalfac)
15632 ! implicit real*8 (a-h,o-z)
15634 ! include 'DIMENSIONS'
15635 ! include 'COMMON.CHAIN'
15636 ! include 'COMMON.DERIV'
15637 ! include 'COMMON.CALC'
15638 ! include 'COMMON.IOUNITS'
15639 real(kind=8),dimension(3) :: dcosom1,dcosom2
15640 real(kind=8) :: scalfac
15641 !el local variables
15642 ! integer :: i,j,k,l
15644 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15645 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15646 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15647 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15651 ! eom12=evdwij*eps1_om12
15653 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15654 ! & " sigder",sigder
15655 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15656 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15658 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15659 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15662 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15665 ! write (iout,*) "gg",(gg(k),k=1,3)
15667 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15668 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15669 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15671 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15672 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15673 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15675 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15676 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15677 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15678 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15681 ! Calculate the components of the gradient in DC and X
15684 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15685 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15688 end subroutine sc_grad_scale
15689 !-----------------------------------------------------------------------------
15690 ! energy_split-sep.F
15691 !-----------------------------------------------------------------------------
15692 subroutine etotal_long(energia)
15694 ! Compute the long-range slow-varying contributions to the energy
15696 ! implicit real*8 (a-h,o-z)
15697 ! include 'DIMENSIONS'
15698 use MD_data, only: totT,usampl,eq_time
15702 !MS$ATTRIBUTES C :: proc_proc
15707 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15709 ! include 'COMMON.SETUP'
15710 ! include 'COMMON.IOUNITS'
15711 ! include 'COMMON.FFIELD'
15712 ! include 'COMMON.DERIV'
15713 ! include 'COMMON.INTERACT'
15714 ! include 'COMMON.SBRIDGE'
15715 ! include 'COMMON.CHAIN'
15716 ! include 'COMMON.VAR'
15717 ! include 'COMMON.LOCAL'
15718 ! include 'COMMON.MD'
15719 real(kind=8),dimension(0:n_ene) :: energia
15720 !el local variables
15721 integer :: i,n_corr,n_corr1,ierror,ierr
15722 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15723 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15724 ecorr,ecorr5,ecorr6,eturn6,time00
15725 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15726 !elwrite(iout,*)"in etotal long"
15728 if (modecalc.eq.12.or.modecalc.eq.14) then
15730 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15732 call int_from_cart1(.false.)
15735 !elwrite(iout,*)"in etotal long"
15738 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15739 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15741 if (nfgtasks.gt.1) then
15743 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15744 if (fg_rank.eq.0) then
15745 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15746 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15748 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15749 ! FG slaves as WEIGHTS array.
15756 weights_(7)=wel_loc
15759 weights_(10)=wturn6
15761 weights_(12)=wscloc
15763 weights_(14)=wtor_d
15764 weights_(15)=wstrain
15765 weights_(16)=wvdwpp
15767 weights_(18)=scal14
15768 weights_(21)=wsccor
15769 ! FG Master broadcasts the WEIGHTS_ array
15770 call MPI_Bcast(weights_(1),n_ene,&
15771 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15773 ! FG slaves receive the WEIGHTS array
15774 call MPI_Bcast(weights(1),n_ene,&
15775 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15790 wstrain=weights(15)
15796 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15798 time_Bcast=time_Bcast+MPI_Wtime()-time00
15799 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15800 ! call chainbuild_cart
15801 ! call int_from_cart1(.false.)
15803 ! write (iout,*) 'Processor',myrank,
15804 ! & ' calling etotal_short ipot=',ipot
15806 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15808 !d print *,'nnt=',nnt,' nct=',nct
15810 !elwrite(iout,*)"in etotal long"
15811 ! Compute the side-chain and electrostatic interaction energy
15813 goto (101,102,103,104,105,106) ipot
15814 ! Lennard-Jones potential.
15815 101 call elj_long(evdw)
15816 !d print '(a)','Exit ELJ'
15818 ! Lennard-Jones-Kihara potential (shifted).
15819 102 call eljk_long(evdw)
15821 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15822 103 call ebp_long(evdw)
15824 ! Gay-Berne potential (shifted LJ, angular dependence).
15825 104 call egb_long(evdw)
15827 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15828 105 call egbv_long(evdw)
15830 ! Soft-sphere potential
15831 106 call e_softsphere(evdw)
15833 ! Calculate electrostatic (H-bonding) energy of the main chain.
15837 if (ipot.lt.6) then
15839 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15840 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15841 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15842 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15844 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15845 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15846 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15847 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15849 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15858 ! write (iout,*) "Soft-spheer ELEC potential"
15859 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15863 ! Calculate excluded-volume interaction energy between peptide groups
15866 if (ipot.lt.6) then
15867 if(wscp.gt.0d0) then
15868 call escp_long(evdw2,evdw2_14)
15874 call escp_soft_sphere(evdw2,evdw2_14)
15877 ! 12/1/95 Multi-body terms
15881 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15882 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15883 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15884 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15885 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15892 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15893 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15896 ! If performing constraint dynamics, call the constraint energy
15897 ! after the equilibration time
15898 if(usampl.and.totT.gt.eq_time) then
15913 energia(2)=evdw2-evdw2_14
15914 energia(18)=evdw2_14
15923 energia(3)=ees+evdw1
15930 energia(8)=eello_turn3
15931 energia(9)=eello_turn4
15933 energia(20)=Uconst+Uconst_back
15934 call sum_energy(energia,.true.)
15935 ! write (iout,*) "Exit ETOTAL_LONG"
15938 end subroutine etotal_long
15939 !-----------------------------------------------------------------------------
15940 subroutine etotal_short(energia)
15942 ! Compute the short-range fast-varying contributions to the energy
15944 ! implicit real*8 (a-h,o-z)
15945 ! include 'DIMENSIONS'
15949 !MS$ATTRIBUTES C :: proc_proc
15954 integer :: ierror,ierr
15955 real(kind=8),dimension(n_ene) :: weights_
15956 real(kind=8) :: time00
15958 ! include 'COMMON.SETUP'
15959 ! include 'COMMON.IOUNITS'
15960 ! include 'COMMON.FFIELD'
15961 ! include 'COMMON.DERIV'
15962 ! include 'COMMON.INTERACT'
15963 ! include 'COMMON.SBRIDGE'
15964 ! include 'COMMON.CHAIN'
15965 ! include 'COMMON.VAR'
15966 ! include 'COMMON.LOCAL'
15967 real(kind=8),dimension(0:n_ene) :: energia
15968 !el local variables
15970 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15971 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
15974 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15976 if (modecalc.eq.12.or.modecalc.eq.14) then
15978 if (fg_rank.eq.0) call int_from_cart1(.false.)
15980 call int_from_cart1(.false.)
15984 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15985 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15987 if (nfgtasks.gt.1) then
15989 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15990 if (fg_rank.eq.0) then
15991 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15992 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15994 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15995 ! FG slaves as WEIGHTS array.
16002 weights_(7)=wel_loc
16005 weights_(10)=wturn6
16007 weights_(12)=wscloc
16009 weights_(14)=wtor_d
16010 weights_(15)=wstrain
16011 weights_(16)=wvdwpp
16013 weights_(18)=scal14
16014 weights_(21)=wsccor
16015 ! FG Master broadcasts the WEIGHTS_ array
16016 call MPI_Bcast(weights_(1),n_ene,&
16017 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16019 ! FG slaves receive the WEIGHTS array
16020 call MPI_Bcast(weights(1),n_ene,&
16021 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16036 wstrain=weights(15)
16042 ! write (iout,*),"Processor",myrank," BROADCAST weights"
16043 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
16045 ! write (iout,*) "Processor",myrank," BROADCAST c"
16046 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
16048 ! write (iout,*) "Processor",myrank," BROADCAST dc"
16049 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
16051 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
16052 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
16054 ! write (iout,*) "Processor",myrank," BROADCAST theta"
16055 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
16057 ! write (iout,*) "Processor",myrank," BROADCAST phi"
16058 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
16060 ! write (iout,*) "Processor",myrank," BROADCAST alph"
16061 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
16063 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
16064 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
16066 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
16067 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
16069 time_Bcast=time_Bcast+MPI_Wtime()-time00
16070 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
16072 ! write (iout,*) 'Processor',myrank,
16073 ! & ' calling etotal_short ipot=',ipot
16075 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
16077 ! call int_from_cart1(.false.)
16079 ! Compute the side-chain and electrostatic interaction energy
16081 goto (101,102,103,104,105,106) ipot
16082 ! Lennard-Jones potential.
16083 101 call elj_short(evdw)
16084 !d print '(a)','Exit ELJ'
16086 ! Lennard-Jones-Kihara potential (shifted).
16087 102 call eljk_short(evdw)
16089 ! Berne-Pechukas potential (dilated LJ, angular dependence).
16090 103 call ebp_short(evdw)
16092 ! Gay-Berne potential (shifted LJ, angular dependence).
16093 104 call egb_short(evdw)
16095 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
16096 105 call egbv_short(evdw)
16098 ! Soft-sphere potential - already dealt with in the long-range part
16100 ! 106 call e_softsphere_short(evdw)
16102 ! Calculate electrostatic (H-bonding) energy of the main chain.
16106 ! Calculate the short-range part of Evdwpp
16108 call evdwpp_short(evdw1)
16110 ! Calculate the short-range part of ESCp
16112 if (ipot.lt.6) then
16113 call escp_short(evdw2,evdw2_14)
16116 ! Calculate the bond-stretching energy
16120 ! Calculate the disulfide-bridge and other energy and the contributions
16121 ! from other distance constraints.
16124 ! Calculate the virtual-bond-angle energy.
16126 call ebend(ebe,ethetacnstr)
16128 ! Calculate the SC local energy.
16133 ! Calculate the virtual-bond torsional energy.
16135 call etor(etors,edihcnstr)
16137 ! 6/23/01 Calculate double-torsional energy
16139 call etor_d(etors_d)
16141 ! 21/5/07 Calculate local sicdechain correlation energy
16143 if (wsccor.gt.0.0d0) then
16144 call eback_sc_corr(esccor)
16149 ! Put energy components into an array
16156 energia(2)=evdw2-evdw2_14
16157 energia(18)=evdw2_14
16170 energia(14)=etors_d
16173 energia(19)=edihcnstr
16175 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
16177 call sum_energy(energia,.true.)
16178 ! write (iout,*) "Exit ETOTAL_SHORT"
16181 end subroutine etotal_short
16182 !-----------------------------------------------------------------------------
16184 !-----------------------------------------------------------------------------
16185 real(kind=8) function gnmr1(y,ymin,ymax)
16187 real(kind=8) :: y,ymin,ymax
16188 real(kind=8) :: wykl=4.0d0
16189 if (y.lt.ymin) then
16190 gnmr1=(ymin-y)**wykl/wykl
16191 else if (y.gt.ymax) then
16192 gnmr1=(y-ymax)**wykl/wykl
16198 !-----------------------------------------------------------------------------
16199 real(kind=8) function gnmr1prim(y,ymin,ymax)
16201 real(kind=8) :: y,ymin,ymax
16202 real(kind=8) :: wykl=4.0d0
16203 if (y.lt.ymin) then
16204 gnmr1prim=-(ymin-y)**(wykl-1)
16205 else if (y.gt.ymax) then
16206 gnmr1prim=(y-ymax)**(wykl-1)
16211 end function gnmr1prim
16212 !----------------------------------------------------------------------------
16213 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
16214 real(kind=8) y,ymin,ymax,sigma
16215 real(kind=8) wykl /4.0d0/
16216 if (y.lt.ymin) then
16217 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
16218 else if (y.gt.ymax) then
16219 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
16224 end function rlornmr1
16225 !------------------------------------------------------------------------------
16226 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
16227 real(kind=8) y,ymin,ymax,sigma
16228 real(kind=8) wykl /4.0d0/
16229 if (y.lt.ymin) then
16230 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
16231 ((ymin-y)**wykl+sigma**wykl)**2
16232 else if (y.gt.ymax) then
16233 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
16234 ((y-ymax)**wykl+sigma**wykl)**2
16239 end function rlornmr1prim
16241 real(kind=8) function harmonic(y,ymax)
16243 real(kind=8) :: y,ymax
16244 real(kind=8) :: wykl=2.0d0
16245 harmonic=(y-ymax)**wykl
16247 end function harmonic
16248 !-----------------------------------------------------------------------------
16249 real(kind=8) function harmonicprim(y,ymax)
16250 real(kind=8) :: y,ymin,ymax
16251 real(kind=8) :: wykl=2.0d0
16252 harmonicprim=(y-ymax)*wykl
16254 end function harmonicprim
16255 !-----------------------------------------------------------------------------
16257 !-----------------------------------------------------------------------------
16258 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
16260 use io_base, only:intout,briefout
16261 ! implicit real*8 (a-h,o-z)
16262 ! include 'DIMENSIONS'
16263 ! include 'COMMON.CHAIN'
16264 ! include 'COMMON.DERIV'
16265 ! include 'COMMON.VAR'
16266 ! include 'COMMON.INTERACT'
16267 ! include 'COMMON.FFIELD'
16268 ! include 'COMMON.MD'
16269 ! include 'COMMON.IOUNITS'
16270 real(kind=8),external :: ufparm
16271 integer :: uiparm(1)
16272 real(kind=8) :: urparm(1)
16273 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
16274 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
16275 integer :: n,nf,ind,ind1,i,k,j
16277 ! This subroutine calculates total internal coordinate gradient.
16278 ! Depending on the number of function evaluations, either whole energy
16279 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
16280 ! internal coordinates are reevaluated or only the cartesian-in-internal
16281 ! coordinate derivatives are evaluated. The subroutine was designed to work
16287 !d print *,'grad',nf,icg
16288 if (nf-nfl+1) 20,30,40
16289 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
16290 ! write (iout,*) 'grad 20'
16291 if (nf.eq.0) return
16293 30 call var_to_geom(n,x)
16295 ! write (iout,*) 'grad 30'
16297 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
16300 ! write (iout,*) 'grad 40'
16301 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
16303 ! Convert the Cartesian gradient into internal-coordinate gradient.
16313 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16315 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
16318 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
16324 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
16326 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
16327 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
16330 if (i.gt.1) g(i-1)=gphii
16331 if (n.gt.nphi) g(nphi+i)=gthetai
16333 if (n.le.nphi+ntheta) goto 10
16335 if (itype(i,1).ne.10) then
16339 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
16342 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
16344 g(ialph(i,1))=galphai
16345 g(ialph(i,1)+nside)=gomegai
16349 ! Add the components corresponding to local energy terms.
16353 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
16354 g(i)=g(i)+gloc(i,icg)
16356 ! Uncomment following three lines for diagnostics.
16358 !elwrite(iout,*) "in gradient after calling intout"
16359 !d call briefout(0,0.0d0)
16360 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
16362 end subroutine gradient
16363 !-----------------------------------------------------------------------------
16364 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
16367 ! implicit real*8 (a-h,o-z)
16368 ! include 'DIMENSIONS'
16369 ! include 'COMMON.DERIV'
16370 ! include 'COMMON.IOUNITS'
16371 ! include 'COMMON.GEO'
16374 !el common /chuju/ jjj
16375 real(kind=8) :: energia(0:n_ene)
16376 integer :: uiparm(1)
16377 real(kind=8) :: urparm(1)
16379 real(kind=8),external :: ufparm
16380 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
16381 ! if (jjj.gt.0) then
16382 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16386 !d print *,'func',nf,nfl,icg
16387 call var_to_geom(n,x)
16390 !d write (iout,*) 'ETOTAL called from FUNC'
16391 call etotal(energia)
16394 ! if (jjj.gt.0) then
16395 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16396 ! write (iout,*) 'f=',etot
16400 end subroutine func
16401 !-----------------------------------------------------------------------------
16402 subroutine cartgrad
16403 ! implicit real*8 (a-h,o-z)
16404 ! include 'DIMENSIONS'
16406 use MD_data, only: totT,usampl,eq_time
16410 ! include 'COMMON.CHAIN'
16411 ! include 'COMMON.DERIV'
16412 ! include 'COMMON.VAR'
16413 ! include 'COMMON.INTERACT'
16414 ! include 'COMMON.FFIELD'
16415 ! include 'COMMON.MD'
16416 ! include 'COMMON.IOUNITS'
16417 ! include 'COMMON.TIME1'
16421 ! This subrouting calculates total Cartesian coordinate gradient.
16422 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
16433 !el write (iout,*) "After sum_gradient"
16435 !el write (iout,*) "After sum_gradient"
16437 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
16438 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
16442 ! If performing constraint dynamics, add the gradients of the constraint energy
16443 if(usampl.and.totT.gt.eq_time) then
16446 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
16447 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
16451 gloc(i,icg)=gloc(i,icg)+dugamma(i)
16454 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
16457 !elwrite (iout,*) "After sum_gradient"
16462 !elwrite (iout,*) "After sum_gradient"
16464 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
16466 ! call checkintcartgrad
16467 ! write(iout,*) 'calling int_to_cart'
16470 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
16474 gcart(j,i)=gradc(j,i,icg)
16475 gxcart(j,i)=gradx(j,i,icg)
16476 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
16479 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
16480 (gxcart(j,i),j=1,3),gloc(i,icg)
16486 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16488 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16491 time_inttocart=time_inttocart+MPI_Wtime()-time01
16494 write (iout,*) "gcart and gxcart after int_to_cart"
16496 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
16497 (gxcart(j,i),j=1,3)
16503 write (iout,*) "CARGRAD"
16507 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16508 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16510 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
16511 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
16513 ! Correction: dummy residues
16516 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
16517 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
16520 if (nct.lt.nres) then
16522 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
16523 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
16528 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
16532 end subroutine cartgrad
16533 !-----------------------------------------------------------------------------
16534 subroutine zerograd
16535 ! implicit real*8 (a-h,o-z)
16536 ! include 'DIMENSIONS'
16537 ! include 'COMMON.DERIV'
16538 ! include 'COMMON.CHAIN'
16539 ! include 'COMMON.VAR'
16540 ! include 'COMMON.MD'
16541 ! include 'COMMON.SCCOR'
16543 !el local variables
16544 integer :: i,j,intertyp,k
16545 ! Initialize Cartesian-coordinate gradient
16547 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16548 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16550 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16551 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16552 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16553 ! allocate(gradcorr_long(3,nres))
16554 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16555 ! allocate(gcorr6_turn_long(3,nres))
16556 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16558 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16560 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16561 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16563 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16564 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16566 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16567 ! allocate(gscloc(3,nres)) !(3,maxres)
16568 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16572 ! common /deriv_scloc/
16573 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16574 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16575 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16577 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16581 ! gradc(j,i,icg)=0.0d0
16582 ! gradx(j,i,icg)=0.0d0
16584 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16585 !elwrite(iout,*) "icg",icg
16589 gradx_scp(j,i)=0.0D0
16591 gvdwc_scp(j,i)=0.0D0
16592 gvdwc_scpp(j,i)=0.0d0
16594 gelc_long(j,i)=0.0D0
16599 gel_loc_long(j,i)=0.0d0
16602 gcorr3_turn(j,i)=0.0d0
16603 gcorr4_turn(j,i)=0.0d0
16604 gradcorr(j,i)=0.0d0
16605 gradcorr_long(j,i)=0.0d0
16606 gradcorr5_long(j,i)=0.0d0
16607 gradcorr6_long(j,i)=0.0d0
16608 gcorr6_turn_long(j,i)=0.0d0
16609 gradcorr5(j,i)=0.0d0
16610 gradcorr6(j,i)=0.0d0
16611 gcorr6_turn(j,i)=0.0d0
16614 gradc(j,i,icg)=0.0d0
16615 gradx(j,i,icg)=0.0d0
16618 gliptran(j,i)=0.0d0
16619 gliptranx(j,i)=0.0d0
16620 gliptranc(j,i)=0.0d0
16621 gshieldx(j,i)=0.0d0
16622 gshieldc(j,i)=0.0d0
16623 gshieldc_loc(j,i)=0.0d0
16624 gshieldx_ec(j,i)=0.0d0
16625 gshieldc_ec(j,i)=0.0d0
16626 gshieldc_loc_ec(j,i)=0.0d0
16627 gshieldx_t3(j,i)=0.0d0
16628 gshieldc_t3(j,i)=0.0d0
16629 gshieldc_loc_t3(j,i)=0.0d0
16630 gshieldx_t4(j,i)=0.0d0
16631 gshieldc_t4(j,i)=0.0d0
16632 gshieldc_loc_t4(j,i)=0.0d0
16633 gshieldx_ll(j,i)=0.0d0
16634 gshieldc_ll(j,i)=0.0d0
16635 gshieldc_loc_ll(j,i)=0.0d0
16637 gg_tube_sc(j,i)=0.0d0
16639 gradb_nucl(j,i)=0.0d0
16640 gradbx_nucl(j,i)=0.0d0
16641 gvdwpp_nucl(j,i)=0.0d0
16645 gvdwpsb1(j,i)=0.0d0
16649 gradcorr_nucl(j,i)=0.0d0
16650 gradcorr3_nucl(j,i)=0.0d0
16651 gradxorr_nucl(j,i)=0.0d0
16652 gradxorr3_nucl(j,i)=0.0d0
16656 gradpepcat(j,i)=0.0d0
16657 gradpepcatx(j,i)=0.0d0
16658 gradcatcat(j,i)=0.0d0
16659 gvdwx_scbase(j,i)=0.0d0
16660 gvdwc_scbase(j,i)=0.0d0
16661 gvdwx_pepbase(j,i)=0.0d0
16662 gvdwc_pepbase(j,i)=0.0d0
16663 gvdwx_scpho(j,i)=0.0d0
16664 gvdwc_scpho(j,i)=0.0d0
16665 gvdwc_peppho(j,i)=0.0d0
16671 gloc_sc(intertyp,i,icg)=0.0d0
16680 grad_shield_side(k,j,i)=0.0d0
16681 grad_shield_loc(k,j,i)=0.0d0
16688 ! Initialize the gradient of local energy terms.
16690 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16691 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16692 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16693 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16694 ! allocate(gel_loc_turn3(nres))
16695 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16696 ! allocate(gsccor_loc(nres)) !(maxres)
16702 gel_loc_loc(i)=0.0d0
16704 g_corr5_loc(i)=0.0d0
16705 g_corr6_loc(i)=0.0d0
16706 gel_loc_turn3(i)=0.0d0
16707 gel_loc_turn4(i)=0.0d0
16708 gel_loc_turn6(i)=0.0d0
16709 gsccor_loc(i)=0.0d0
16711 ! initialize gcart and gxcart
16712 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
16720 end subroutine zerograd
16721 !-----------------------------------------------------------------------------
16722 real(kind=8) function fdum()
16726 !-----------------------------------------------------------------------------
16728 !-----------------------------------------------------------------------------
16729 subroutine intcartderiv
16730 ! implicit real*8 (a-h,o-z)
16731 ! include 'DIMENSIONS'
16735 ! include 'COMMON.SETUP'
16736 ! include 'COMMON.CHAIN'
16737 ! include 'COMMON.VAR'
16738 ! include 'COMMON.GEO'
16739 ! include 'COMMON.INTERACT'
16740 ! include 'COMMON.DERIV'
16741 ! include 'COMMON.IOUNITS'
16742 ! include 'COMMON.LOCAL'
16743 ! include 'COMMON.SCCOR'
16744 real(kind=8) :: pi4,pi34
16745 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
16746 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
16747 dcosomega,dsinomega !(3,3,maxres)
16748 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
16751 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
16752 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
16753 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
16754 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
16758 !el from module energy-------------
16759 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
16760 !el allocate(dsintau(3,3,3,itau_start:itau_end))
16761 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
16763 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
16764 !el allocate(dsintau(3,3,3,0:nres2))
16765 !el allocate(dtauangle(3,3,3,0:nres2))
16766 !el allocate(domicron(3,2,2,0:nres2))
16767 !el allocate(dcosomicron(3,2,2,0:nres2))
16771 #if defined(MPI) && defined(PARINTDER)
16772 if (nfgtasks.gt.1 .and. me.eq.king) &
16773 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
16778 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
16779 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16781 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16784 dtheta(j,1,i)=0.0d0
16785 dtheta(j,2,i)=0.0d0
16791 ! Derivatives of theta's
16792 #if defined(MPI) && defined(PARINTDER)
16793 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16794 do i=max0(ithet_start-1,3),ithet_end
16798 cost=dcos(theta(i))
16799 sint=sqrt(1-cost*cost)
16801 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16803 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16804 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16806 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16809 #if defined(MPI) && defined(PARINTDER)
16810 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16811 do i=max0(ithet_start-1,3),ithet_end
16815 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
16816 cost1=dcos(omicron(1,i))
16817 sint1=sqrt(1-cost1*cost1)
16818 cost2=dcos(omicron(2,i))
16819 sint2=sqrt(1-cost2*cost2)
16821 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16822 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16823 cost1*dc_norm(j,i-2))/ &
16825 domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
16826 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16827 +cost1*(dc_norm(j,i-1+nres)))/ &
16829 domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
16830 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16831 !C Looks messy but better than if in loop
16832 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16833 +cost2*dc_norm(j,i-1))/ &
16835 domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
16836 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16837 +cost2*(-dc_norm(j,i-1+nres)))/ &
16839 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
16840 domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
16844 !elwrite(iout,*) "after vbld write"
16845 ! Derivatives of phi:
16846 ! If phi is 0 or 180 degrees, then the formulas
16847 ! have to be derived by power series expansion of the
16848 ! conventional formulas around 0 and 180.
16850 do i=iphi1_start,iphi1_end
16854 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
16855 ! the conventional case
16856 sint=dsin(theta(i))
16857 sint1=dsin(theta(i-1))
16859 cost=dcos(theta(i))
16860 cost1=dcos(theta(i-1))
16862 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16863 fac0=1.0d0/(sint1*sint)
16866 fac3=cosg*cost1/(sint1*sint1)
16867 fac4=cosg*cost/(sint*sint)
16868 ! Obtaining the gamma derivatives from sine derivative
16869 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16870 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16871 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16872 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16873 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16874 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16878 cosg_inv=1.0d0/cosg
16879 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16880 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16881 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16882 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16884 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16885 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16886 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16887 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16888 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16889 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16890 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16892 ! Bug fixed 3/24/05 (AL)
16894 ! Obtaining the gamma derivatives from cosine derivative
16897 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16898 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16899 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16900 dc_norm(j,i-3))/vbld(i-2)
16901 dphi(j,1,i)=-1.0/sing*dcosphi(j,1,i)
16902 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16903 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16905 dphi(j,2,i)=-1.0/sing*dcosphi(j,2,i)
16906 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16907 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16908 dc_norm(j,i-1))/vbld(i)
16909 dphi(j,3,i)=-1.0/sing*dcosphi(j,3,i)
16912 write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
16919 !alculate derivative of Tauangle
16921 do i=itau_start,itau_end
16924 !elwrite(iout,*) " vecpr",i,nres
16926 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16927 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
16928 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
16929 !c dtauangle(j,intertyp,dervityp,residue number)
16930 !c INTERTYP=1 SC...Ca...Ca..Ca
16931 ! the conventional case
16932 sint=dsin(theta(i))
16933 sint1=dsin(omicron(2,i-1))
16934 sing=dsin(tauangle(1,i))
16935 cost=dcos(theta(i))
16936 cost1=dcos(omicron(2,i-1))
16937 cosg=dcos(tauangle(1,i))
16938 !elwrite(iout,*) " vecpr5",i,nres
16940 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16941 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16942 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16943 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16945 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16946 fac0=1.0d0/(sint1*sint)
16949 fac3=cosg*cost1/(sint1*sint1)
16950 fac4=cosg*cost/(sint*sint)
16951 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16952 ! Obtaining the gamma derivatives from sine derivative
16953 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16954 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16955 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16956 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16957 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16958 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16962 cosg_inv=1.0d0/cosg
16963 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16964 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16965 *vbld_inv(i-2+nres)
16966 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16967 dsintau(j,1,2,i)= &
16968 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16969 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16970 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16971 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16972 ! Bug fixed 3/24/05 (AL)
16973 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16974 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16975 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16976 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16978 ! Obtaining the gamma derivatives from cosine derivative
16981 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16982 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16983 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16984 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16985 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16986 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16988 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16989 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16990 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16991 dc_norm(j,i-1))/vbld(i)
16992 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16993 ! write (iout,*) "else",i
16997 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
17000 !C Second case Ca...Ca...Ca...SC
17002 do i=itau_start,itau_end
17006 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
17007 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
17008 ! the conventional case
17009 sint=dsin(omicron(1,i))
17010 sint1=dsin(theta(i-1))
17011 sing=dsin(tauangle(2,i))
17012 cost=dcos(omicron(1,i))
17013 cost1=dcos(theta(i-1))
17014 cosg=dcos(tauangle(2,i))
17016 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
17018 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
17019 fac0=1.0d0/(sint1*sint)
17022 fac3=cosg*cost1/(sint1*sint1)
17023 fac4=cosg*cost/(sint*sint)
17024 ! Obtaining the gamma derivatives from sine derivative
17025 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
17026 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
17027 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
17028 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
17029 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
17030 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
17034 cosg_inv=1.0d0/cosg
17035 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
17036 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
17037 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
17038 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
17039 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
17040 dsintau(j,2,2,i)= &
17041 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
17042 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17043 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
17044 ! & sing*ctgt*domicron(j,1,2,i),
17045 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17046 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
17047 ! Bug fixed 3/24/05 (AL)
17048 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
17049 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
17050 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17051 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
17053 ! Obtaining the gamma derivatives from cosine derivative
17056 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
17057 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
17058 dc_norm(j,i-3))/vbld(i-2)
17059 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
17060 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
17061 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
17062 dcosomicron(j,1,1,i)
17063 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
17064 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
17065 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
17066 dc_norm(j,i-1+nres))/vbld(i-1+nres)
17067 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
17068 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
17073 !CC third case SC...Ca...Ca...SC
17076 do i=itau_start,itau_end
17080 ! the conventional case
17081 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
17082 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
17083 sint=dsin(omicron(1,i))
17084 sint1=dsin(omicron(2,i-1))
17085 sing=dsin(tauangle(3,i))
17086 cost=dcos(omicron(1,i))
17087 cost1=dcos(omicron(2,i-1))
17088 cosg=dcos(tauangle(3,i))
17090 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
17091 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
17093 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
17094 fac0=1.0d0/(sint1*sint)
17097 fac3=cosg*cost1/(sint1*sint1)
17098 fac4=cosg*cost/(sint*sint)
17099 ! Obtaining the gamma derivatives from sine derivative
17100 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
17101 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
17102 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
17103 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
17104 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
17105 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
17109 cosg_inv=1.0d0/cosg
17110 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
17111 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
17112 *vbld_inv(i-2+nres)
17113 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
17114 dsintau(j,3,2,i)= &
17115 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
17116 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17117 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
17118 ! Bug fixed 3/24/05 (AL)
17119 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
17120 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
17121 *vbld_inv(i-1+nres)
17122 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17123 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
17125 ! Obtaining the gamma derivatives from cosine derivative
17128 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
17129 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
17130 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
17131 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
17132 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
17133 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
17134 dcosomicron(j,1,1,i)
17135 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
17136 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
17137 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
17138 dc_norm(j,i-1+nres))/vbld(i-1+nres)
17139 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
17140 ! write(iout,*) "else",i
17146 ! Derivatives of side-chain angles alpha and omega
17147 #if defined(MPI) && defined(PARINTDER)
17148 do i=ibond_start,ibond_end
17152 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
17153 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
17156 fac8=fac5/vbld(i+1)
17157 fac9=fac5/vbld(i+nres)
17158 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
17159 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
17160 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
17161 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
17162 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
17163 sina=sqrt(1-cosa*cosa)
17165 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
17167 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
17168 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
17169 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
17170 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
17171 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
17172 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
17173 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
17174 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
17176 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
17178 ! obtaining the derivatives of omega from sines
17179 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
17180 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
17181 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
17182 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
17184 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
17185 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
17186 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
17187 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
17188 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
17189 coso_inv=1.0d0/dcos(omeg(i))
17191 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
17192 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
17193 (sino*dc_norm(j,i-1))/vbld(i)
17194 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
17195 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
17196 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
17197 -sino*dc_norm(j,i)/vbld(i+1)
17198 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
17199 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
17200 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
17202 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
17205 ! obtaining the derivatives of omega from cosines
17206 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
17207 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
17212 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
17213 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
17214 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
17215 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
17216 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
17217 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
17218 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
17219 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
17220 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
17221 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
17222 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
17223 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
17224 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
17225 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
17226 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
17232 dalpha(k,j,i)=0.0d0
17233 domega(k,j,i)=0.0d0
17239 #if defined(MPI) && defined(PARINTDER)
17240 if (nfgtasks.gt.1) then
17242 !d write (iout,*) "Gather dtheta"
17243 !d call flush(iout)
17244 write (iout,*) "dtheta before gather"
17246 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
17249 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
17250 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
17251 king,FG_COMM,IERROR)
17254 !d write (iout,*) "Gather dphi"
17255 !d call flush(iout)
17256 write (iout,*) "dphi before gather"
17258 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
17262 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
17263 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
17264 king,FG_COMM,IERROR)
17265 !d write (iout,*) "Gather dalpha"
17266 !d call flush(iout)
17268 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
17269 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17270 king,FG_COMM,IERROR)
17271 !d write (iout,*) "Gather domega"
17272 !d call flush(iout)
17273 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
17274 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17275 king,FG_COMM,IERROR)
17281 write (iout,*) "dtheta after gather"
17283 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
17285 write (iout,*) "dphi after gather"
17287 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
17289 write (iout,*) "dalpha after gather"
17291 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
17293 write (iout,*) "domega after gather"
17295 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
17300 end subroutine intcartderiv
17301 !-----------------------------------------------------------------------------
17302 subroutine checkintcartgrad
17303 ! implicit real*8 (a-h,o-z)
17304 ! include 'DIMENSIONS'
17308 ! include 'COMMON.CHAIN'
17309 ! include 'COMMON.VAR'
17310 ! include 'COMMON.GEO'
17311 ! include 'COMMON.INTERACT'
17312 ! include 'COMMON.DERIV'
17313 ! include 'COMMON.IOUNITS'
17314 ! include 'COMMON.SETUP'
17315 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
17316 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
17317 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
17318 real(kind=8),dimension(3) :: dc_norm_s
17319 real(kind=8) :: aincr=1.0d-5
17321 real(kind=8) :: dcji
17324 theta_s(i)=theta(i)
17328 ! Check theta gradient
17330 "Analytical (upper) and numerical (lower) gradient of theta"
17335 dc(j,i-2)=dcji+aincr
17336 call chainbuild_cart
17337 call int_from_cart1(.false.)
17338 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
17341 dc(j,i-1)=dc(j,i-1)+aincr
17342 call chainbuild_cart
17343 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
17346 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
17347 !el (dtheta(j,2,i),j=1,3)
17348 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
17349 !el (dthetanum(j,2,i),j=1,3)
17350 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
17351 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
17352 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
17355 ! Check gamma gradient
17357 "Analytical (upper) and numerical (lower) gradient of gamma"
17361 dc(j,i-3)=dcji+aincr
17362 call chainbuild_cart
17363 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
17366 dc(j,i-2)=dcji+aincr
17367 call chainbuild_cart
17368 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
17371 dc(j,i-1)=dc(j,i-1)+aincr
17372 call chainbuild_cart
17373 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
17376 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
17377 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
17378 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
17379 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
17380 !el write (iout,'(5x,3(3f10.5,5x))') &
17381 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
17382 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
17383 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
17386 ! Check alpha gradient
17388 "Analytical (upper) and numerical (lower) gradient of alpha"
17390 if(itype(i,1).ne.10) then
17393 dc(j,i-1)=dcji+aincr
17394 call chainbuild_cart
17395 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
17400 call chainbuild_cart
17401 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
17405 dc(j,i+nres)=dc(j,i+nres)+aincr
17406 call chainbuild_cart
17407 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
17412 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
17413 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
17414 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
17415 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
17416 !el write (iout,'(5x,3(3f10.5,5x))') &
17417 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
17418 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
17419 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
17422 ! Check omega gradient
17424 "Analytical (upper) and numerical (lower) gradient of omega"
17426 if(itype(i,1).ne.10) then
17429 dc(j,i-1)=dcji+aincr
17430 call chainbuild_cart
17431 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
17436 call chainbuild_cart
17437 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
17441 dc(j,i+nres)=dc(j,i+nres)+aincr
17442 call chainbuild_cart
17443 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
17448 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
17449 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
17450 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
17451 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
17452 !el write (iout,'(5x,3(3f10.5,5x))') &
17453 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
17454 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
17455 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
17459 end subroutine checkintcartgrad
17460 !-----------------------------------------------------------------------------
17462 !-----------------------------------------------------------------------------
17463 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
17464 ! implicit real*8 (a-h,o-z)
17465 ! include 'DIMENSIONS'
17466 ! include 'COMMON.IOUNITS'
17467 ! include 'COMMON.CHAIN'
17468 ! include 'COMMON.INTERACT'
17469 ! include 'COMMON.VAR'
17470 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
17471 integer :: kkk,nsep=3
17472 real(kind=8) :: qm !dist,
17473 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
17474 logical :: lprn=.false.
17476 ! real(kind=8) :: sigm,x
17478 !el sigm(x)=0.25d0*x ! local function
17484 do il=seg1+nsep,seg2
17487 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
17488 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
17489 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17491 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17492 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17495 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17496 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17497 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17498 dijCM=dist(il+nres,jl+nres)
17499 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17501 qq = qq+qqij+qqijCM
17507 if((seg3-il).lt.3) then
17514 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17515 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17516 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17518 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17519 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17522 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17523 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17524 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17525 dijCM=dist(il+nres,jl+nres)
17526 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17528 qq = qq+qqij+qqijCM
17533 if (qqmax.le.qq) qqmax=qq
17535 qwolynes=1.0d0-qqmax
17537 end function qwolynes
17538 !-----------------------------------------------------------------------------
17539 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
17540 ! implicit real*8 (a-h,o-z)
17541 ! include 'DIMENSIONS'
17542 ! include 'COMMON.IOUNITS'
17543 ! include 'COMMON.CHAIN'
17544 ! include 'COMMON.INTERACT'
17545 ! include 'COMMON.VAR'
17546 ! include 'COMMON.MD'
17547 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
17548 integer :: nsep=3, kkk
17549 !el real(kind=8) :: dist
17550 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
17551 logical :: lprn=.false.
17553 real(kind=8) :: sim,dd0,fac,ddqij
17554 !el sigm(x)=0.25d0*x ! local function
17564 do il=seg1+nsep,seg2
17567 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17568 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17569 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17571 sim = 1.0d0/sigm(d0ij)
17574 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17576 ddqij = (c(k,il)-c(k,jl))*fac
17577 dqwol(k,il)=dqwol(k,il)+ddqij
17578 dqwol(k,jl)=dqwol(k,jl)-ddqij
17581 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17584 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17585 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17586 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17587 dijCM=dist(il+nres,jl+nres)
17588 sim = 1.0d0/sigm(d0ijCM)
17591 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17593 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17594 dxqwol(k,il)=dxqwol(k,il)+ddqij
17595 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17602 if((seg3-il).lt.3) then
17609 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17610 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17611 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17613 sim = 1.0d0/sigm(d0ij)
17616 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17618 ddqij = (c(k,il)-c(k,jl))*fac
17619 dqwol(k,il)=dqwol(k,il)+ddqij
17620 dqwol(k,jl)=dqwol(k,jl)-ddqij
17622 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17625 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17626 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17627 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17628 dijCM=dist(il+nres,jl+nres)
17629 sim = 1.0d0/sigm(d0ijCM)
17632 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17634 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17635 dxqwol(k,il)=dxqwol(k,il)+ddqij
17636 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17645 dqwol(j,i)=dqwol(j,i)/nl
17646 dxqwol(j,i)=dxqwol(j,i)/nl
17650 end subroutine qwolynes_prim
17651 !-----------------------------------------------------------------------------
17652 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
17653 ! implicit real*8 (a-h,o-z)
17654 ! include 'DIMENSIONS'
17655 ! include 'COMMON.IOUNITS'
17656 ! include 'COMMON.CHAIN'
17657 ! include 'COMMON.INTERACT'
17658 ! include 'COMMON.VAR'
17659 integer :: seg1,seg2,seg3,seg4
17661 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
17662 real(kind=8),dimension(3,0:2*nres) :: cdummy
17663 real(kind=8) :: q1,q2
17664 real(kind=8) :: delta=1.0d-10
17669 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17671 c(j,i)=c(j,i)+delta
17672 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17673 qwolan(j,i)=(q2-q1)/delta
17679 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17680 cdummy(j,i+nres)=c(j,i+nres)
17681 c(j,i+nres)=c(j,i+nres)+delta
17682 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17683 qwolxan(j,i)=(q2-q1)/delta
17684 c(j,i+nres)=cdummy(j,i+nres)
17687 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
17689 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
17691 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
17693 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
17696 end subroutine qwol_num
17697 !-----------------------------------------------------------------------------
17698 subroutine EconstrQ
17699 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
17700 ! implicit real*8 (a-h,o-z)
17701 ! include 'DIMENSIONS'
17702 ! include 'COMMON.CONTROL'
17703 ! include 'COMMON.VAR'
17704 ! include 'COMMON.MD'
17707 ! include 'COMMON.LANGEVIN'
17709 ! include 'COMMON.LANGEVIN.lang0'
17711 ! include 'COMMON.CHAIN'
17712 ! include 'COMMON.DERIV'
17713 ! include 'COMMON.GEO'
17714 ! include 'COMMON.LOCAL'
17715 ! include 'COMMON.INTERACT'
17716 ! include 'COMMON.IOUNITS'
17717 ! include 'COMMON.NAMES'
17718 ! include 'COMMON.TIME1'
17719 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
17720 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
17722 integer :: kstart,kend,lstart,lend,idummy
17723 real(kind=8) :: delta=1.0d-7
17724 integer :: i,j,k,ii
17728 dudconst(j,i)=0.0d0
17729 duxconst(j,i)=0.0d0
17730 dudxconst(j,i)=0.0d0
17735 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17737 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
17738 ! Calculating the derivatives of Constraint energy with respect to Q
17739 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
17741 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
17742 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
17743 ! hmnum=(hm2-hm1)/delta
17744 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
17745 ! & qinfrag(i,iset))
17746 ! write(iout,*) "harmonicnum frag", hmnum
17747 ! Calculating the derivatives of Q with respect to cartesian coordinates
17748 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17750 ! write(iout,*) "dqwol "
17752 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17754 ! write(iout,*) "dxqwol "
17756 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17758 ! Calculating numerical gradients of dU/dQi and dQi/dxi
17759 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
17760 ! & ,idummy,idummy)
17761 ! The gradients of Uconst in Cs
17764 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
17765 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
17770 kstart=ifrag(1,ipair(1,i,iset),iset)
17771 kend=ifrag(2,ipair(1,i,iset),iset)
17772 lstart=ifrag(1,ipair(2,i,iset),iset)
17773 lend=ifrag(2,ipair(2,i,iset),iset)
17774 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
17775 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
17776 ! Calculating dU/dQ
17777 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
17778 ! hm1=harmonic(qpair(i),qinpair(i,iset))
17779 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
17780 ! hmnum=(hm2-hm1)/delta
17781 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
17782 ! & qinpair(i,iset))
17783 ! write(iout,*) "harmonicnum pair ", hmnum
17784 ! Calculating dQ/dXi
17785 call qwolynes_prim(kstart,kend,.false.,&
17787 ! write(iout,*) "dqwol "
17789 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17791 ! write(iout,*) "dxqwol "
17793 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17795 ! Calculating numerical gradients
17796 ! call qwol_num(kstart,kend,.false.
17798 ! The gradients of Uconst in Cs
17801 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17802 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17806 ! write(iout,*) "Uconst inside subroutine ", Uconst
17807 ! Transforming the gradients from Cs to dCs for the backbone
17811 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17815 ! Transforming the gradients from Cs to dCs for the side chains
17818 dudxconst(j,i)=duxconst(j,i)
17821 ! write(iout,*) "dU/ddc backbone "
17823 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17825 ! write(iout,*) "dU/ddX side chain "
17827 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17829 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17830 ! call dEconstrQ_num
17832 end subroutine EconstrQ
17833 !-----------------------------------------------------------------------------
17834 subroutine dEconstrQ_num
17835 ! Calculating numerical dUconst/ddc and dUconst/ddx
17836 ! implicit real*8 (a-h,o-z)
17837 ! include 'DIMENSIONS'
17838 ! include 'COMMON.CONTROL'
17839 ! include 'COMMON.VAR'
17840 ! include 'COMMON.MD'
17843 ! include 'COMMON.LANGEVIN'
17845 ! include 'COMMON.LANGEVIN.lang0'
17847 ! include 'COMMON.CHAIN'
17848 ! include 'COMMON.DERIV'
17849 ! include 'COMMON.GEO'
17850 ! include 'COMMON.LOCAL'
17851 ! include 'COMMON.INTERACT'
17852 ! include 'COMMON.IOUNITS'
17853 ! include 'COMMON.NAMES'
17854 ! include 'COMMON.TIME1'
17855 real(kind=8) :: uzap1,uzap2
17856 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17857 integer :: kstart,kend,lstart,lend,idummy
17858 real(kind=8) :: delta=1.0d-7
17859 !el local variables
17865 dUcartan(j,i)=0.0d0
17866 cdummy(j,i)=dc(j,i)
17867 dc(j,i)=dc(j,i)+delta
17868 call chainbuild_cart
17871 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17873 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17877 kstart=ifrag(1,ipair(1,ii,iset),iset)
17878 kend=ifrag(2,ipair(1,ii,iset),iset)
17879 lstart=ifrag(1,ipair(2,ii,iset),iset)
17880 lend=ifrag(2,ipair(2,ii,iset),iset)
17881 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17882 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17885 dc(j,i)=cdummy(j,i)
17886 call chainbuild_cart
17889 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17891 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17895 kstart=ifrag(1,ipair(1,ii,iset),iset)
17896 kend=ifrag(2,ipair(1,ii,iset),iset)
17897 lstart=ifrag(1,ipair(2,ii,iset),iset)
17898 lend=ifrag(2,ipair(2,ii,iset),iset)
17899 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17900 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17903 ducartan(j,i)=(uzap2-uzap1)/(delta)
17906 ! Calculating numerical gradients for dU/ddx
17908 duxcartan(j,i)=0.0d0
17910 cdummy(j,i)=dc(j,i+nres)
17911 dc(j,i+nres)=dc(j,i+nres)+delta
17912 call chainbuild_cart
17915 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17917 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17921 kstart=ifrag(1,ipair(1,ii,iset),iset)
17922 kend=ifrag(2,ipair(1,ii,iset),iset)
17923 lstart=ifrag(1,ipair(2,ii,iset),iset)
17924 lend=ifrag(2,ipair(2,ii,iset),iset)
17925 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17926 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17929 dc(j,i+nres)=cdummy(j,i)
17930 call chainbuild_cart
17933 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17934 ifrag(2,ii,iset),.true.,idummy,idummy)
17935 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17939 kstart=ifrag(1,ipair(1,ii,iset),iset)
17940 kend=ifrag(2,ipair(1,ii,iset),iset)
17941 lstart=ifrag(1,ipair(2,ii,iset),iset)
17942 lend=ifrag(2,ipair(2,ii,iset),iset)
17943 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17944 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17947 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17950 write(iout,*) "Numerical dUconst/ddc backbone "
17952 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17954 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17956 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17959 end subroutine dEconstrQ_num
17960 !-----------------------------------------------------------------------------
17962 !-----------------------------------------------------------------------------
17963 subroutine check_energies
17965 ! use random, only: ran_number
17969 ! include 'DIMENSIONS'
17970 ! include 'COMMON.CHAIN'
17971 ! include 'COMMON.VAR'
17972 ! include 'COMMON.IOUNITS'
17973 ! include 'COMMON.SBRIDGE'
17974 ! include 'COMMON.LOCAL'
17975 ! include 'COMMON.GEO'
17977 ! External functions
17978 !EL double precision ran_number
17979 !EL external ran_number
17982 integer :: i,j,k,l,lmax,p,pmax
17983 real(kind=8) :: rmin,rmax
17984 real(kind=8) :: eij
17987 real(kind=8) :: wi,rij,tj,pj
18009 !t wi=ran_number(0.0D0,pi)
18010 ! wi=ran_number(0.0D0,pi/6.0D0)
18012 !t tj=ran_number(0.0D0,pi)
18013 !t pj=ran_number(0.0D0,pi)
18014 ! pj=ran_number(0.0D0,pi/6.0D0)
18018 !t rij=ran_number(rmin,rmax)
18020 c(1,j)=d*sin(pj)*cos(tj)
18021 c(2,j)=d*sin(pj)*sin(tj)
18027 c(3,i)=-rij-d*cos(wi)
18030 dc(k,nres+i)=c(k,nres+i)-c(k,i)
18031 dc_norm(k,nres+i)=dc(k,nres+i)/d
18032 dc(k,nres+j)=c(k,nres+j)-c(k,j)
18033 dc_norm(k,nres+j)=dc(k,nres+j)/d
18036 call dyn_ssbond_ene(i,j,eij)
18041 end subroutine check_energies
18042 !-----------------------------------------------------------------------------
18043 subroutine dyn_ssbond_ene(resi,resj,eij)
18048 ! include 'DIMENSIONS'
18049 ! include 'COMMON.SBRIDGE'
18050 ! include 'COMMON.CHAIN'
18051 ! include 'COMMON.DERIV'
18052 ! include 'COMMON.LOCAL'
18053 ! include 'COMMON.INTERACT'
18054 ! include 'COMMON.VAR'
18055 ! include 'COMMON.IOUNITS'
18056 ! include 'COMMON.CALC'
18060 ! include 'COMMON.MD'
18061 ! use MD, only: totT,t_bath
18064 ! External functions
18065 !EL double precision h_base
18066 !EL external h_base
18069 integer :: resi,resj
18072 real(kind=8) :: eij
18075 logical :: havebond
18076 integer itypi,itypj
18077 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
18078 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
18079 real(kind=8),dimension(3) :: dcosom1,dcosom2
18081 real(kind=8) :: pom1,pom2
18082 real(kind=8) :: ljA,ljB,ljXs
18083 real(kind=8),dimension(1:3) :: d_ljB
18084 real(kind=8) :: ssA,ssB,ssC,ssXs
18085 real(kind=8) :: ssxm,ljxm,ssm,ljm
18086 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
18087 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
18088 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
18089 !-------FIRST METHOD
18091 real(kind=8),dimension(1:3) :: d_xm
18092 !-------END FIRST METHOD
18093 !-------SECOND METHOD
18094 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
18095 !-------END SECOND METHOD
18097 !-------TESTING CODE
18098 !el logical :: checkstop,transgrad
18099 !el common /sschecks/ checkstop,transgrad
18101 integer :: icheck,nicheck,jcheck,njcheck
18102 real(kind=8),dimension(-1:1) :: echeck
18103 real(kind=8) :: deps,ssx0,ljx0
18104 !-------END TESTING CODE
18110 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
18111 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
18114 dxi=dc_norm(1,nres+i)
18115 dyi=dc_norm(2,nres+i)
18116 dzi=dc_norm(3,nres+i)
18117 dsci_inv=vbld_inv(i+nres)
18120 xj=c(1,nres+j)-c(1,nres+i)
18121 yj=c(2,nres+j)-c(2,nres+i)
18122 zj=c(3,nres+j)-c(3,nres+i)
18123 dxj=dc_norm(1,nres+j)
18124 dyj=dc_norm(2,nres+j)
18125 dzj=dc_norm(3,nres+j)
18126 dscj_inv=vbld_inv(j+nres)
18128 chi1=chi(itypi,itypj)
18129 chi2=chi(itypj,itypi)
18136 alf12=0.5D0*(alf1+alf2)
18138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
18139 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18140 ! The following are set in sc_angular
18144 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
18145 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
18146 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
18148 rij=1.0D0/rij ! Reset this so it makes sense
18150 sig0ij=sigma(itypi,itypj)
18151 sig=sig0ij*dsqrt(1.0D0/sigsq)
18154 ljA=eps1*eps2rt**2*eps3rt**2
18155 ljB=ljA*bb_aq(itypi,itypj)
18156 ljA=ljA*aa_aq(itypi,itypj)
18157 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
18162 deltat12=om2-om1+2.0d0
18163 cosphi=om12-om1*om2
18167 +akth*(deltat1*deltat1+deltat2*deltat2) &
18168 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
18169 ssxm=ssXs-0.5D0*ssB/ssA
18171 !-------TESTING CODE
18172 !$$$c Some extra output
18173 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18174 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
18175 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
18176 !$$$ if (ssx0.gt.0.0d0) then
18177 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
18181 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
18182 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
18183 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
18185 !-------END TESTING CODE
18187 !-------TESTING CODE
18188 ! Stop and plot energy and derivative as a function of distance
18189 if (checkstop) then
18190 ssm=ssC-0.25D0*ssB*ssB/ssA
18191 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18192 if (ssm.lt.ljm .and. &
18193 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
18201 if (.not.checkstop) then
18206 do icheck=0,nicheck
18207 do jcheck=-1,njcheck
18208 if (checkstop) rij=(ssxm-1.0d0)+ &
18209 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
18210 !-------END TESTING CODE
18212 if (rij.gt.ljxm) then
18215 fac=(1.0D0/ljd)**expon
18216 e1=fac*fac*aa_aq(itypi,itypj)
18217 e2=fac*bb_aq(itypi,itypj)
18218 eij=eps1*eps2rt*eps3rt*(e1+e2)
18221 eij=eij*eps2rt*eps3rt
18224 e1=e1*eps1*eps2rt**2*eps3rt**2
18225 ed=-expon*(e1+eij)/ljd
18227 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
18228 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
18229 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
18230 -2.0D0*alf12*eps3der+sigder*sigsq_om12
18231 else if (rij.lt.ssxm) then
18234 eij=ssA*ssd*ssd+ssB*ssd+ssC
18236 ed=2*akcm*ssd+akct*deltat12
18238 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
18239 eom1=-2*akth*deltat1-pom1-om2*pom2
18240 eom2= 2*akth*deltat2+pom1-om1*pom2
18243 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
18245 d_ssxm(1)=0.5D0*akct/ssA
18246 d_ssxm(2)=-d_ssxm(1)
18249 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
18250 d_ljxm(2)=d_ljxm(1)*sigsq_om2
18251 d_ljxm(3)=d_ljxm(1)*sigsq_om12
18252 d_ljxm(1)=d_ljxm(1)*sigsq_om1
18254 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18255 xm=0.5d0*(ssxm+ljxm)
18257 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
18259 if (rij.lt.xm) then
18261 ssm=ssC-0.25D0*ssB*ssB/ssA
18262 d_ssm(1)=0.5D0*akct*ssB/ssA
18263 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18264 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18266 f1=(rij-xm)/(ssxm-xm)
18267 f2=(rij-ssxm)/(xm-ssxm)
18271 delta_inv=1.0d0/(xm-ssxm)
18272 deltasq_inv=delta_inv*delta_inv
18274 fac1=deltasq_inv*fac*(xm-rij)
18275 fac2=deltasq_inv*fac*(rij-ssxm)
18276 ed=delta_inv*(Ht*hd2-ssm*hd1)
18277 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
18278 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
18279 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
18282 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18283 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
18284 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
18285 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
18287 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
18288 f1=(rij-ljxm)/(xm-ljxm)
18289 f2=(rij-xm)/(ljxm-xm)
18293 delta_inv=1.0d0/(ljxm-xm)
18294 deltasq_inv=delta_inv*delta_inv
18296 fac1=deltasq_inv*fac*(ljxm-rij)
18297 fac2=deltasq_inv*fac*(rij-xm)
18298 ed=delta_inv*(ljm*hd2-Ht*hd1)
18299 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
18300 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
18301 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
18303 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18305 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18311 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
18312 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
18313 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
18315 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18316 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
18317 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18318 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18319 !$$$ d_ssm(3)=omega
18321 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
18323 !$$$ d_ljm(k)=ljm*d_ljB(k)
18327 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
18328 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
18329 !$$$ d_ss(2)=akct*ssd
18330 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
18331 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
18334 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
18335 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
18336 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
18338 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
18339 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
18341 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
18343 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
18344 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
18345 !$$$ h1=h_base(f1,hd1)
18346 !$$$ h2=h_base(f2,hd2)
18347 !$$$ eij=ss*h1+ljf*h2
18348 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
18349 !$$$ deltasq_inv=delta_inv*delta_inv
18350 !$$$ fac=ljf*hd2-ss*hd1
18351 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
18352 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
18353 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
18354 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
18355 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
18356 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
18357 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
18359 !$$$ havebond=.false.
18360 !$$$ if (ed.gt.0.0d0) havebond=.true.
18361 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18368 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
18369 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18370 ! & "SSBOND_E_FORM",totT,t_bath,i,j
18374 dyn_ssbond_ij(i,j)=eij
18375 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
18376 dyn_ssbond_ij(i,j)=1.0d300
18379 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18380 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
18385 !-------TESTING CODE
18386 !el if (checkstop) then
18387 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
18388 "CHECKSTOP",rij,eij,ed
18392 if (checkstop) then
18393 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
18396 if (checkstop) then
18400 !-------END TESTING CODE
18403 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
18404 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
18407 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
18410 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
18411 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
18412 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
18413 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
18414 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
18415 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
18419 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
18424 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18425 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18429 end subroutine dyn_ssbond_ene
18430 !--------------------------------------------------------------------------
18431 subroutine triple_ssbond_ene(resi,resj,resk,eij)
18436 ! include 'DIMENSIONS'
18437 ! include 'COMMON.SBRIDGE'
18438 ! include 'COMMON.CHAIN'
18439 ! include 'COMMON.DERIV'
18440 ! include 'COMMON.LOCAL'
18441 ! include 'COMMON.INTERACT'
18442 ! include 'COMMON.VAR'
18443 ! include 'COMMON.IOUNITS'
18444 ! include 'COMMON.CALC'
18448 ! include 'COMMON.MD'
18449 ! use MD, only: totT,t_bath
18452 double precision h_base
18456 integer resi,resj,resk,m,itypi,itypj,itypk
18458 !c Output arguments
18459 double precision eij,eij1,eij2,eij3
18463 !c integer itypi,itypj,k,l
18464 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
18465 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
18466 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
18467 double precision sig0ij,ljd,sig,fac,e1,e2
18468 double precision dcosom1(3),dcosom2(3),ed
18469 double precision pom1,pom2
18470 double precision ljA,ljB,ljXs
18471 double precision d_ljB(1:3)
18472 double precision ssA,ssB,ssC,ssXs
18473 double precision ssxm,ljxm,ssm,ljm
18474 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
18476 if (dtriss.eq.0) return
18480 !C write(iout,*) resi,resj,resk
18482 dxi=dc_norm(1,nres+i)
18483 dyi=dc_norm(2,nres+i)
18484 dzi=dc_norm(3,nres+i)
18485 dsci_inv=vbld_inv(i+nres)
18494 dxj=dc_norm(1,nres+j)
18495 dyj=dc_norm(2,nres+j)
18496 dzj=dc_norm(3,nres+j)
18497 dscj_inv=vbld_inv(j+nres)
18503 dxk=dc_norm(1,nres+k)
18504 dyk=dc_norm(2,nres+k)
18505 dzk=dc_norm(3,nres+k)
18506 dscj_inv=vbld_inv(k+nres)
18516 rrij=(xij*xij+yij*yij+zij*zij)
18517 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18518 rrik=(xik*xik+yik*yik+zik*zik)
18520 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
18522 !C there are three combination of distances for each trisulfide bonds
18523 !C The first case the ith atom is the center
18524 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
18525 !C distance y is second distance the a,b,c,d are parameters derived for
18526 !C this problem d parameter was set as a penalty currenlty set to 1.
18527 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
18530 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
18532 !C second case jth atom is center
18533 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
18536 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
18538 !C the third case kth atom is the center
18539 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
18542 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
18548 !C write(iout,*)i,j,k,eij
18549 !C The energy penalty calculated now time for the gradient part
18550 !C derivative over rij
18551 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18552 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
18557 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18558 gvdwx(m,j)=gvdwx(m,j)+gg(m)
18562 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18563 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18565 !C now derivative over rik
18566 fac=-eij1**2/dtriss* &
18567 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18568 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18573 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18574 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18577 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18578 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18580 !C now derivative over rjk
18581 fac=-eij2**2/dtriss* &
18582 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18583 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18588 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18589 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18592 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18593 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18596 end subroutine triple_ssbond_ene
18600 !-----------------------------------------------------------------------------
18601 real(kind=8) function h_base(x,deriv)
18602 ! A smooth function going 0->1 in range [0,1]
18603 ! It should NOT be called outside range [0,1], it will not work there.
18610 real(kind=8) :: deriv
18613 real(kind=8) :: xsq
18616 ! Two parabolas put together. First derivative zero at extrema
18617 !$$$ if (x.lt.0.5D0) then
18618 !$$$ h_base=2.0D0*x*x
18622 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18623 !$$$ deriv=4.0D0*deriv
18626 ! Third degree polynomial. First derivative zero at extrema
18627 h_base=x*x*(3.0d0-2.0d0*x)
18628 deriv=6.0d0*x*(1.0d0-x)
18630 ! Fifth degree polynomial. First and second derivatives zero at extrema
18632 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
18634 !$$$ deriv=deriv*deriv
18635 !$$$ deriv=30.0d0*xsq*deriv
18638 end function h_base
18639 !-----------------------------------------------------------------------------
18640 subroutine dyn_set_nss
18641 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
18643 use MD_data, only: totT,t_bath
18645 ! include 'DIMENSIONS'
18649 ! include 'COMMON.SBRIDGE'
18650 ! include 'COMMON.CHAIN'
18651 ! include 'COMMON.IOUNITS'
18652 ! include 'COMMON.SETUP'
18653 ! include 'COMMON.MD'
18655 real(kind=8) :: emin
18656 integer :: i,j,imin,ierr
18657 integer :: diff,allnss,newnss
18658 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18661 integer,dimension(0:nfgtasks) :: i_newnss
18662 integer,dimension(0:nfgtasks) :: displ
18663 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18664 integer :: g_newnss
18669 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
18678 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18682 if (allflag(i).eq.0 .and. &
18683 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
18684 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
18688 if (emin.lt.1.0d300) then
18691 if (allflag(i).eq.0 .and. &
18692 (allihpb(i).eq.allihpb(imin) .or. &
18693 alljhpb(i).eq.allihpb(imin) .or. &
18694 allihpb(i).eq.alljhpb(imin) .or. &
18695 alljhpb(i).eq.alljhpb(imin))) then
18702 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18706 if (allflag(i).eq.1) then
18708 newihpb(newnss)=allihpb(i)
18709 newjhpb(newnss)=alljhpb(i)
18714 if (nfgtasks.gt.1)then
18716 call MPI_Reduce(newnss,g_newnss,1,&
18717 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
18718 call MPI_Gather(newnss,1,MPI_INTEGER,&
18719 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
18721 do i=1,nfgtasks-1,1
18722 displ(i)=i_newnss(i-1)+displ(i-1)
18724 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
18725 g_newihpb,i_newnss,displ,MPI_INTEGER,&
18727 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
18728 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
18730 if(fg_rank.eq.0) then
18731 ! print *,'g_newnss',g_newnss
18732 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
18733 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
18736 newihpb(i)=g_newihpb(i)
18737 newjhpb(i)=g_newjhpb(i)
18745 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
18746 ! print *,newnss,nss,maxdim
18752 if (idssb(i).eq.newihpb(j) .and. &
18753 jdssb(i).eq.newjhpb(j)) found=.true.
18757 ! write(iout,*) "found",found,i,j
18758 if (.not.found.and.fg_rank.eq.0) &
18759 write(iout,'(a15,f12.2,f8.1,2i5)') &
18760 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
18769 if (newihpb(i).eq.idssb(j) .and. &
18770 newjhpb(i).eq.jdssb(j)) found=.true.
18774 ! write(iout,*) "found",found,i,j
18775 if (.not.found.and.fg_rank.eq.0) &
18776 write(iout,'(a15,f12.2,f8.1,2i5)') &
18777 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
18784 idssb(i)=newihpb(i)
18785 jdssb(i)=newjhpb(i)
18789 end subroutine dyn_set_nss
18790 ! Lipid transfer energy function
18791 subroutine Eliptransfer(eliptran)
18792 !C this is done by Adasko
18793 !C print *,"wchodze"
18794 !C structure of box:
18796 !C--bordliptop-- buffore starts
18797 !C--bufliptop--- here true lipid starts
18799 !C--buflipbot--- lipid ends buffore starts
18800 !C--bordlipbot--buffore ends
18801 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
18804 ! print *, "I am in eliptran"
18805 do i=ilip_start,ilip_end
18807 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
18810 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
18811 if (positi.le.0.0) positi=positi+boxzsize
18813 !C first for peptide groups
18814 !c for each residue check if it is in lipid or lipid water border area
18815 if ((positi.gt.bordlipbot) &
18816 .and.(positi.lt.bordliptop)) then
18817 !C the energy transfer exist
18818 if (positi.lt.buflipbot) then
18819 !C what fraction I am in
18821 ((positi-bordlipbot)/lipbufthick)
18822 !C lipbufthick is thickenes of lipid buffore
18823 sslip=sscalelip(fracinbuf)
18824 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18825 eliptran=eliptran+sslip*pepliptran
18826 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18827 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18828 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18830 !C print *,"doing sccale for lower part"
18831 !C print *,i,sslip,fracinbuf,ssgradlip
18832 elseif (positi.gt.bufliptop) then
18833 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
18834 sslip=sscalelip(fracinbuf)
18835 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18836 eliptran=eliptran+sslip*pepliptran
18837 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18838 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18839 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18840 !C print *, "doing sscalefor top part"
18841 !C print *,i,sslip,fracinbuf,ssgradlip
18843 eliptran=eliptran+pepliptran
18844 !C print *,"I am in true lipid"
18847 !C eliptran=elpitran+0.0 ! I am in water
18849 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
18851 ! here starts the side chain transfer
18852 do i=ilip_start,ilip_end
18853 if (itype(i,1).eq.ntyp1) cycle
18854 positi=(mod(c(3,i+nres),boxzsize))
18855 if (positi.le.0) positi=positi+boxzsize
18856 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18857 !c for each residue check if it is in lipid or lipid water border area
18858 !C respos=mod(c(3,i+nres),boxzsize)
18859 !C print *,positi,bordlipbot,buflipbot
18860 if ((positi.gt.bordlipbot) &
18861 .and.(positi.lt.bordliptop)) then
18862 !C the energy transfer exist
18863 if (positi.lt.buflipbot) then
18865 ((positi-bordlipbot)/lipbufthick)
18866 !C lipbufthick is thickenes of lipid buffore
18867 sslip=sscalelip(fracinbuf)
18868 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18869 eliptran=eliptran+sslip*liptranene(itype(i,1))
18870 gliptranx(3,i)=gliptranx(3,i) &
18871 +ssgradlip*liptranene(itype(i,1))
18872 gliptranc(3,i-1)= gliptranc(3,i-1) &
18873 +ssgradlip*liptranene(itype(i,1))
18874 !C print *,"doing sccale for lower part"
18875 elseif (positi.gt.bufliptop) then
18877 ((bordliptop-positi)/lipbufthick)
18878 sslip=sscalelip(fracinbuf)
18879 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18880 eliptran=eliptran+sslip*liptranene(itype(i,1))
18881 gliptranx(3,i)=gliptranx(3,i) &
18882 +ssgradlip*liptranene(itype(i,1))
18883 gliptranc(3,i-1)= gliptranc(3,i-1) &
18884 +ssgradlip*liptranene(itype(i,1))
18885 !C print *, "doing sscalefor top part",sslip,fracinbuf
18887 eliptran=eliptran+liptranene(itype(i,1))
18888 !C print *,"I am in true lipid"
18890 endif ! if in lipid or buffor
18892 !C eliptran=elpitran+0.0 ! I am in water
18893 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
18896 end subroutine Eliptransfer
18897 !----------------------------------NANO FUNCTIONS
18898 !C-----------------------------------------------------------------------
18899 !C-----------------------------------------------------------
18900 !C This subroutine is to mimic the histone like structure but as well can be
18901 !C utilizet to nanostructures (infinit) small modification has to be used to
18902 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18903 !C gradient has to be modified at the ends
18904 !C The energy function is Kihara potential
18905 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18906 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18907 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18908 !C simple Kihara potential
18909 subroutine calctube(Etube)
18910 real(kind=8),dimension(3) :: vectube
18911 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18912 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
18913 sc_aa_tube,sc_bb_tube
18916 do i=itube_start,itube_end
18918 enetube(i+nres)=0.0d0
18920 !C first we calculate the distance from tube center
18922 do i=itube_start,itube_end
18923 !C lets ommit dummy atoms for now
18924 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18925 !C now calculate distance from center of tube and direction vectors
18928 ! Find minimum distance in periodic box
18930 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18931 vectube(1)=vectube(1)+boxxsize*j
18932 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18933 vectube(2)=vectube(2)+boxysize*j
18934 xminact=abs(vectube(1)-tubecenter(1))
18935 yminact=abs(vectube(2)-tubecenter(2))
18936 if (xmin.gt.xminact) then
18940 if (ymin.gt.yminact) then
18947 vectube(1)=vectube(1)-tubecenter(1)
18948 vectube(2)=vectube(2)-tubecenter(2)
18950 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18951 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18953 !C as the tube is infinity we do not calculate the Z-vector use of Z
18956 !C now calculte the distance
18957 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18958 !C now normalize vector
18959 vectube(1)=vectube(1)/tub_r
18960 vectube(2)=vectube(2)/tub_r
18961 !C calculte rdiffrence between r and r0
18964 rdiff6=rdiff**6.0d0
18965 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18966 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18967 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18968 !C print *,rdiff,rdiff6,pep_aa_tube
18969 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18970 !C now we calculate gradient
18971 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18972 6.0d0*pep_bb_tube)/rdiff6/rdiff
18973 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18975 !C now direction of gg_tube vector
18977 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18978 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18981 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18982 !C print *,gg_tube(1,0),"TU"
18985 do i=itube_start,itube_end
18986 !C Lets not jump over memory as we use many times iti
18988 !C lets ommit dummy atoms for now
18989 if ((iti.eq.ntyp1) &
18990 !C in UNRES uncomment the line below as GLY has no side-chain...
18996 vectube(1)=mod((c(1,i+nres)),boxxsize)
18997 vectube(1)=vectube(1)+boxxsize*j
18998 vectube(2)=mod((c(2,i+nres)),boxysize)
18999 vectube(2)=vectube(2)+boxysize*j
19001 xminact=abs(vectube(1)-tubecenter(1))
19002 yminact=abs(vectube(2)-tubecenter(2))
19003 if (xmin.gt.xminact) then
19007 if (ymin.gt.yminact) then
19014 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19016 vectube(1)=vectube(1)-tubecenter(1)
19017 vectube(2)=vectube(2)-tubecenter(2)
19019 !C as the tube is infinity we do not calculate the Z-vector use of Z
19022 !C now calculte the distance
19023 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19024 !C now normalize vector
19025 vectube(1)=vectube(1)/tub_r
19026 vectube(2)=vectube(2)/tub_r
19028 !C calculte rdiffrence between r and r0
19031 rdiff6=rdiff**6.0d0
19032 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19033 sc_aa_tube=sc_aa_tube_par(iti)
19034 sc_bb_tube=sc_bb_tube_par(iti)
19035 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19036 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19037 6.0d0*sc_bb_tube/rdiff6/rdiff
19038 !C now direction of gg_tube vector
19040 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19041 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19044 do i=itube_start,itube_end
19045 Etube=Etube+enetube(i)+enetube(i+nres)
19047 !C print *,"ETUBE", etube
19049 end subroutine calctube
19050 !C TO DO 1) add to total energy
19051 !C 2) add to gradient summation
19052 !C 3) add reading parameters (AND of course oppening of PARAM file)
19053 !C 4) add reading the center of tube
19055 !C 6) add to zerograd
19056 !C 7) allocate matrices
19059 !C-----------------------------------------------------------------------
19060 !C-----------------------------------------------------------
19061 !C This subroutine is to mimic the histone like structure but as well can be
19062 !C utilizet to nanostructures (infinit) small modification has to be used to
19063 !C make it finite (z gradient at the ends has to be changes as well as the x,y
19064 !C gradient has to be modified at the ends
19065 !C The energy function is Kihara potential
19066 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
19067 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
19068 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
19069 !C simple Kihara potential
19070 subroutine calctube2(Etube)
19071 real(kind=8),dimension(3) :: vectube
19072 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19073 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
19074 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
19077 do i=itube_start,itube_end
19079 enetube(i+nres)=0.0d0
19081 !C first we calculate the distance from tube center
19082 !C first sugare-phosphate group for NARES this would be peptide group
19084 do i=itube_start,itube_end
19085 !C lets ommit dummy atoms for now
19087 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19088 !C now calculate distance from center of tube and direction vectors
19089 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19090 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19091 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19092 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19096 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19097 vectube(1)=vectube(1)+boxxsize*j
19098 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19099 vectube(2)=vectube(2)+boxysize*j
19101 xminact=abs(vectube(1)-tubecenter(1))
19102 yminact=abs(vectube(2)-tubecenter(2))
19103 if (xmin.gt.xminact) then
19107 if (ymin.gt.yminact) then
19114 vectube(1)=vectube(1)-tubecenter(1)
19115 vectube(2)=vectube(2)-tubecenter(2)
19117 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19118 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19120 !C as the tube is infinity we do not calculate the Z-vector use of Z
19123 !C now calculte the distance
19124 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19125 !C now normalize vector
19126 vectube(1)=vectube(1)/tub_r
19127 vectube(2)=vectube(2)/tub_r
19128 !C calculte rdiffrence between r and r0
19131 rdiff6=rdiff**6.0d0
19132 !C THIS FRAGMENT MAKES TUBE FINITE
19133 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19134 if (positi.le.0) positi=positi+boxzsize
19135 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19136 !c for each residue check if it is in lipid or lipid water border area
19137 !C respos=mod(c(3,i+nres),boxzsize)
19138 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19139 if ((positi.gt.bordtubebot) &
19140 .and.(positi.lt.bordtubetop)) then
19141 !C the energy transfer exist
19142 if (positi.lt.buftubebot) then
19144 ((positi-bordtubebot)/tubebufthick)
19145 !C lipbufthick is thickenes of lipid buffore
19146 sstube=sscalelip(fracinbuf)
19147 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19148 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19149 enetube(i)=enetube(i)+sstube*tubetranenepep
19150 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19151 !C &+ssgradtube*tubetranene(itype(i,1))
19152 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19153 !C &+ssgradtube*tubetranene(itype(i,1))
19154 !C print *,"doing sccale for lower part"
19155 elseif (positi.gt.buftubetop) then
19157 ((bordtubetop-positi)/tubebufthick)
19158 sstube=sscalelip(fracinbuf)
19159 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19160 enetube(i)=enetube(i)+sstube*tubetranenepep
19161 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19162 !C &+ssgradtube*tubetranene(itype(i,1))
19163 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19164 !C &+ssgradtube*tubetranene(itype(i,1))
19165 !C print *, "doing sscalefor top part",sslip,fracinbuf
19169 enetube(i)=enetube(i)+sstube*tubetranenepep
19170 !C print *,"I am in true lipid"
19174 !C ssgradtube=0.0d0
19176 endif ! if in lipid or buffor
19178 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19179 enetube(i)=enetube(i)+sstube* &
19180 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
19181 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19182 !C print *,rdiff,rdiff6,pep_aa_tube
19183 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19184 !C now we calculate gradient
19185 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19186 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
19187 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19190 !C now direction of gg_tube vector
19192 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19193 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19195 gg_tube(3,i)=gg_tube(3,i) &
19196 +ssgradtube*enetube(i)/sstube/2.0d0
19197 gg_tube(3,i-1)= gg_tube(3,i-1) &
19198 +ssgradtube*enetube(i)/sstube/2.0d0
19201 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
19202 !C print *,gg_tube(1,0),"TU"
19203 do i=itube_start,itube_end
19204 !C Lets not jump over memory as we use many times iti
19206 !C lets ommit dummy atoms for now
19207 if ((iti.eq.ntyp1) &
19208 !!C in UNRES uncomment the line below as GLY has no side-chain...
19211 vectube(1)=c(1,i+nres)
19212 vectube(1)=mod(vectube(1),boxxsize)
19213 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19214 vectube(2)=c(2,i+nres)
19215 vectube(2)=mod(vectube(2),boxysize)
19216 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19218 vectube(1)=vectube(1)-tubecenter(1)
19219 vectube(2)=vectube(2)-tubecenter(2)
19220 !C THIS FRAGMENT MAKES TUBE FINITE
19221 positi=(mod(c(3,i+nres),boxzsize))
19222 if (positi.le.0) positi=positi+boxzsize
19223 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19224 !c for each residue check if it is in lipid or lipid water border area
19225 !C respos=mod(c(3,i+nres),boxzsize)
19226 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19228 if ((positi.gt.bordtubebot) &
19229 .and.(positi.lt.bordtubetop)) then
19230 !C the energy transfer exist
19231 if (positi.lt.buftubebot) then
19233 ((positi-bordtubebot)/tubebufthick)
19234 !C lipbufthick is thickenes of lipid buffore
19235 sstube=sscalelip(fracinbuf)
19236 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19237 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19238 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19239 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19240 !C &+ssgradtube*tubetranene(itype(i,1))
19241 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19242 !C &+ssgradtube*tubetranene(itype(i,1))
19243 !C print *,"doing sccale for lower part"
19244 elseif (positi.gt.buftubetop) then
19246 ((bordtubetop-positi)/tubebufthick)
19248 sstube=sscalelip(fracinbuf)
19249 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19250 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19251 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19252 !C &+ssgradtube*tubetranene(itype(i,1))
19253 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19254 !C &+ssgradtube*tubetranene(itype(i,1))
19255 !C print *, "doing sscalefor top part",sslip,fracinbuf
19259 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19260 !C print *,"I am in true lipid"
19264 !C ssgradtube=0.0d0
19266 endif ! if in lipid or buffor
19267 !CEND OF FINITE FRAGMENT
19268 !C as the tube is infinity we do not calculate the Z-vector use of Z
19271 !C now calculte the distance
19272 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19273 !C now normalize vector
19274 vectube(1)=vectube(1)/tub_r
19275 vectube(2)=vectube(2)/tub_r
19276 !C calculte rdiffrence between r and r0
19279 rdiff6=rdiff**6.0d0
19280 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19281 sc_aa_tube=sc_aa_tube_par(iti)
19282 sc_bb_tube=sc_bb_tube_par(iti)
19283 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
19284 *sstube+enetube(i+nres)
19285 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19286 !C now we calculate gradient
19287 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
19288 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
19289 !C now direction of gg_tube vector
19291 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19292 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19294 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
19295 +ssgradtube*enetube(i+nres)/sstube
19296 gg_tube(3,i-1)= gg_tube(3,i-1) &
19297 +ssgradtube*enetube(i+nres)/sstube
19300 do i=itube_start,itube_end
19301 Etube=Etube+enetube(i)+enetube(i+nres)
19303 !C print *,"ETUBE", etube
19305 end subroutine calctube2
19306 !=====================================================================================================================================
19307 subroutine calcnano(Etube)
19308 real(kind=8),dimension(3) :: vectube
19310 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19311 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
19312 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
19313 integer:: i,j,iti,r
19316 ! print *,itube_start,itube_end,"poczatek"
19317 do i=itube_start,itube_end
19319 enetube(i+nres)=0.0d0
19321 !C first we calculate the distance from tube center
19322 !C first sugare-phosphate group for NARES this would be peptide group
19324 do i=itube_start,itube_end
19325 !C lets ommit dummy atoms for now
19326 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19327 !C now calculate distance from center of tube and direction vectors
19333 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19334 vectube(1)=vectube(1)+boxxsize*j
19335 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19336 vectube(2)=vectube(2)+boxysize*j
19337 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19338 vectube(3)=vectube(3)+boxzsize*j
19341 xminact=dabs(vectube(1)-tubecenter(1))
19342 yminact=dabs(vectube(2)-tubecenter(2))
19343 zminact=dabs(vectube(3)-tubecenter(3))
19345 if (xmin.gt.xminact) then
19349 if (ymin.gt.yminact) then
19353 if (zmin.gt.zminact) then
19362 vectube(1)=vectube(1)-tubecenter(1)
19363 vectube(2)=vectube(2)-tubecenter(2)
19364 vectube(3)=vectube(3)-tubecenter(3)
19366 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19367 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19368 !C as the tube is infinity we do not calculate the Z-vector use of Z
19370 !C vectube(3)=0.0d0
19371 !C now calculte the distance
19372 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19373 !C now normalize vector
19374 vectube(1)=vectube(1)/tub_r
19375 vectube(2)=vectube(2)/tub_r
19376 vectube(3)=vectube(3)/tub_r
19377 !C calculte rdiffrence between r and r0
19380 rdiff6=rdiff**6.0d0
19381 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19382 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19383 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19384 !C print *,rdiff,rdiff6,pep_aa_tube
19385 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19386 !C now we calculate gradient
19387 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19388 6.0d0*pep_bb_tube)/rdiff6/rdiff
19389 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19391 if (acavtubpep.eq.0.0d0) then
19396 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
19398 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
19401 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
19402 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
19403 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
19404 /denominator**2.0d0
19409 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
19411 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19412 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19416 do i=itube_start,itube_end
19417 enecavtube(i)=0.0d0
19418 !C Lets not jump over memory as we use many times iti
19420 !C lets ommit dummy atoms for now
19421 if ((iti.eq.ntyp1) &
19422 !C in UNRES uncomment the line below as GLY has no side-chain...
19429 vectube(1)=dmod((c(1,i+nres)),boxxsize)
19430 vectube(1)=vectube(1)+boxxsize*j
19431 vectube(2)=dmod((c(2,i+nres)),boxysize)
19432 vectube(2)=vectube(2)+boxysize*j
19433 vectube(3)=dmod((c(3,i+nres)),boxzsize)
19434 vectube(3)=vectube(3)+boxzsize*j
19437 xminact=dabs(vectube(1)-tubecenter(1))
19438 yminact=dabs(vectube(2)-tubecenter(2))
19439 zminact=dabs(vectube(3)-tubecenter(3))
19441 if (xmin.gt.xminact) then
19445 if (ymin.gt.yminact) then
19449 if (zmin.gt.zminact) then
19458 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19460 vectube(1)=vectube(1)-tubecenter(1)
19461 vectube(2)=vectube(2)-tubecenter(2)
19462 vectube(3)=vectube(3)-tubecenter(3)
19463 !C now calculte the distance
19464 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19465 !C now normalize vector
19466 vectube(1)=vectube(1)/tub_r
19467 vectube(2)=vectube(2)/tub_r
19468 vectube(3)=vectube(3)/tub_r
19470 !C calculte rdiffrence between r and r0
19473 rdiff6=rdiff**6.0d0
19474 sc_aa_tube=sc_aa_tube_par(iti)
19475 sc_bb_tube=sc_bb_tube_par(iti)
19476 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19477 !C enetube(i+nres)=0.0d0
19478 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19479 !C now we calculate gradient
19480 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19481 6.0d0*sc_bb_tube/rdiff6/rdiff
19483 !C now direction of gg_tube vector
19484 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
19485 if (acavtub(iti).eq.0.0d0) then
19487 enecavtube(i+nres)=0.0d0
19490 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
19491 enecavtube(i+nres)= &
19492 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
19494 !C enecavtube(i)=0.0
19495 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
19496 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
19497 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
19498 /denominator**2.0d0
19503 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
19504 !C & enecavtube(i),faccav
19505 !C print *,"licz=",
19506 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
19507 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
19509 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19510 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19512 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
19517 do i=itube_start,itube_end
19518 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
19519 +enecavtube(i+nres)
19522 ! print *,"begin", i,"a"
19525 ! rdiff6=rdiff**6.0d0
19526 ! sc_aa_tube=sc_aa_tube_par(i)
19527 ! sc_bb_tube=sc_bb_tube_par(i)
19528 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19529 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
19531 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
19534 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
19536 ! print *,"end",i,"a"
19538 !C print *,"ETUBE", etube
19540 end subroutine calcnano
19542 !===============================================
19543 !--------------------------------------------------------------------------------
19544 !C first for shielding is setting of function of side-chains
19546 subroutine set_shield_fac2
19547 real(kind=8) :: div77_81=0.974996043d0, &
19548 div4_81=0.2222222222d0
19549 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
19550 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
19551 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
19552 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
19553 !C the vector between center of side_chain and peptide group
19554 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
19555 pept_group,costhet_grad,cosphi_grad_long, &
19556 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
19557 sh_frac_dist_grad,pep_side
19559 !C write(2,*) "ivec",ivec_start,ivec_end
19561 fac_shield(i)=0.0d0
19564 grad_shield(j,i)=0.0d0
19567 do i=ivec_start,ivec_end
19569 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19570 ! ishield_list(i)=0
19571 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19572 !Cif there two consequtive dummy atoms there is no peptide group between them
19573 !C the line below has to be changed for FGPROC>1
19576 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
19580 !C first lets set vector conecting the ithe side-chain with kth side-chain
19581 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
19582 !C pep_side(j)=2.0d0
19583 !C and vector conecting the side-chain with its proper calfa
19584 side_calf(j)=c(j,k+nres)-c(j,k)
19585 !C side_calf(j)=2.0d0
19586 pept_group(j)=c(j,i)-c(j,i+1)
19587 !C lets have their lenght
19588 dist_pep_side=pep_side(j)**2+dist_pep_side
19589 dist_side_calf=dist_side_calf+side_calf(j)**2
19590 dist_pept_group=dist_pept_group+pept_group(j)**2
19592 dist_pep_side=sqrt(dist_pep_side)
19593 dist_pept_group=sqrt(dist_pept_group)
19594 dist_side_calf=sqrt(dist_side_calf)
19596 pep_side_norm(j)=pep_side(j)/dist_pep_side
19597 side_calf_norm(j)=dist_side_calf
19599 !C now sscale fraction
19600 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19601 ! print *,buff_shield,"buff",sh_frac_dist
19603 if (sh_frac_dist.le.0.0) cycle
19604 !C print *,ishield_list(i),i
19605 !C If we reach here it means that this side chain reaches the shielding sphere
19606 !C Lets add him to the list for gradient
19607 ishield_list(i)=ishield_list(i)+1
19608 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19609 !C this list is essential otherwise problem would be O3
19610 shield_list(ishield_list(i),i)=k
19611 !C Lets have the sscale value
19612 if (sh_frac_dist.gt.1.0) then
19613 scale_fac_dist=1.0d0
19615 sh_frac_dist_grad(j)=0.0d0
19618 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19619 *(2.0d0*sh_frac_dist-3.0d0)
19620 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19621 /dist_pep_side/buff_shield*0.5d0
19623 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19624 !C sh_frac_dist_grad(j)=0.0d0
19625 !C scale_fac_dist=1.0d0
19626 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19627 !C & sh_frac_dist_grad(j)
19630 !C this is what is now we have the distance scaling now volume...
19631 short=short_r_sidechain(itype(k,1))
19632 long=long_r_sidechain(itype(k,1))
19633 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
19634 sinthet=short/dist_pep_side*costhet
19635 ! print *,"SORT",short,long,sinthet,costhet
19636 !C now costhet_grad
19639 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
19640 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
19641 !C & -short/dist_pep_side**2/costhet)
19642 !C costhet_fac=0.0d0
19644 costhet_grad(j)=costhet_fac*pep_side(j)
19646 !C remember for the final gradient multiply costhet_grad(j)
19647 !C for side_chain by factor -2 !
19648 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
19649 !C pep_side0pept_group is vector multiplication
19650 pep_side0pept_group=0.0d0
19652 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
19654 cosalfa=(pep_side0pept_group/ &
19655 (dist_pep_side*dist_side_calf))
19656 fac_alfa_sin=1.0d0-cosalfa**2
19657 fac_alfa_sin=dsqrt(fac_alfa_sin)
19658 rkprim=fac_alfa_sin*(long-short)+short
19661 !C now costhet_grad
19662 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
19664 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
19665 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
19669 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
19670 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19671 *(long-short)/fac_alfa_sin*cosalfa/ &
19672 ((dist_pep_side*dist_side_calf))* &
19673 ((side_calf(j))-cosalfa* &
19674 ((pep_side(j)/dist_pep_side)*dist_side_calf))
19675 !C cosphi_grad_long(j)=0.0d0
19676 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19677 *(long-short)/fac_alfa_sin*cosalfa &
19678 /((dist_pep_side*dist_side_calf))* &
19680 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
19681 !C cosphi_grad_loc(j)=0.0d0
19683 !C print *,sinphi,sinthet
19684 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
19687 !C now the gradient...
19689 grad_shield(j,i)=grad_shield(j,i) &
19690 !C gradient po skalowaniu
19691 +(sh_frac_dist_grad(j)*VofOverlap &
19692 !C gradient po costhet
19693 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
19694 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
19695 sinphi/sinthet*costhet*costhet_grad(j) &
19696 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19698 !C grad_shield_side is Cbeta sidechain gradient
19699 grad_shield_side(j,ishield_list(i),i)=&
19700 (sh_frac_dist_grad(j)*-2.0d0&
19702 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19703 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
19704 sinphi/sinthet*costhet*costhet_grad(j)&
19705 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19707 ! print *, 1.0d0/(-dsqrt(1.0d0-sinphi*sinthet)),&
19709 ! +sinthet/sinphi,"HERE"
19710 grad_shield_loc(j,ishield_list(i),i)= &
19711 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19712 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
19713 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
19716 ! print *,grad_shield_loc(j,ishield_list(i),i)
19718 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
19720 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
19722 ! write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
19725 end subroutine set_shield_fac2
19726 !----------------------------------------------------------------------------
19727 ! SOUBROUTINE FOR AFM
19728 subroutine AFMvel(Eafmforce)
19729 use MD_data, only:totTafm
19730 real(kind=8),dimension(3) :: diffafm
19731 real(kind=8) :: afmdist,Eafmforce
19733 !C Only for check grad COMMENT if not used for checkgrad
19735 !C--------------------------------------------------------
19736 !C print *,"wchodze"
19740 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19741 afmdist=afmdist+diffafm(i)**2
19743 afmdist=dsqrt(afmdist)
19745 Eafmforce=0.5d0*forceAFMconst &
19746 *(distafminit+totTafm*velAFMconst-afmdist)**2
19747 !C Eafmforce=-forceAFMconst*(dist-distafminit)
19749 gradafm(i,afmend-1)=-forceAFMconst* &
19750 (distafminit+totTafm*velAFMconst-afmdist) &
19751 *diffafm(i)/afmdist
19752 gradafm(i,afmbeg-1)=forceAFMconst* &
19753 (distafminit+totTafm*velAFMconst-afmdist) &
19754 *diffafm(i)/afmdist
19756 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
19758 end subroutine AFMvel
19759 !---------------------------------------------------------
19760 subroutine AFMforce(Eafmforce)
19762 real(kind=8),dimension(3) :: diffafm
19763 ! real(kind=8) ::afmdist
19764 real(kind=8) :: afmdist,Eafmforce
19769 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19770 afmdist=afmdist+diffafm(i)**2
19772 afmdist=dsqrt(afmdist)
19773 ! print *,afmdist,distafminit
19774 Eafmforce=-forceAFMconst*(afmdist-distafminit)
19776 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
19777 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
19779 !C print *,'AFM',Eafmforce
19781 end subroutine AFMforce
19783 !-----------------------------------------------------------------------------
19785 subroutine read_ssHist
19788 ! include 'DIMENSIONS'
19789 ! include "DIMENSIONS.FREE"
19790 ! include 'COMMON.FREE'
19793 character(len=80) :: controlcard
19796 call card_concat(controlcard,.true.)
19797 read(controlcard,*) &
19798 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
19802 end subroutine read_ssHist
19804 !-----------------------------------------------------------------------------
19805 integer function indmat(i,j)
19807 ! get the position of the jth ijth fragment of the chain coordinate system
19808 ! in the fromto array.
19811 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
19813 end function indmat
19814 !-----------------------------------------------------------------------------
19815 real(kind=8) function sigm(x)
19821 !-----------------------------------------------------------------------------
19822 !-----------------------------------------------------------------------------
19823 subroutine alloc_ener_arrays
19824 !EL Allocation of arrays used by module energy
19825 use MD_data, only: mset
19826 !el local variables
19829 if(nres.lt.100) then
19831 elseif(nres.lt.200) then
19832 maxconts=0.8*nres ! Max. number of contacts per residue
19834 maxconts=0.6*nres ! (maxconts=maxres/4)
19836 maxcont=12*nres ! Max. number of SC contacts
19837 maxvar=6*nres ! Max. number of variables
19838 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19839 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19840 !----------------------
19841 ! arrays in subroutine init_int_table
19843 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
19844 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
19846 allocate(nint_gr(nres))
19847 allocate(nscp_gr(nres))
19848 allocate(ielstart(nres))
19849 allocate(ielend(nres))
19851 allocate(istart(nres,maxint_gr))
19852 allocate(iend(nres,maxint_gr))
19853 !(maxres,maxint_gr)
19854 allocate(iscpstart(nres,maxint_gr))
19855 allocate(iscpend(nres,maxint_gr))
19856 !(maxres,maxint_gr)
19857 allocate(ielstart_vdw(nres))
19858 allocate(ielend_vdw(nres))
19860 allocate(nint_gr_nucl(nres))
19861 allocate(nscp_gr_nucl(nres))
19862 allocate(ielstart_nucl(nres))
19863 allocate(ielend_nucl(nres))
19865 allocate(istart_nucl(nres,maxint_gr))
19866 allocate(iend_nucl(nres,maxint_gr))
19867 !(maxres,maxint_gr)
19868 allocate(iscpstart_nucl(nres,maxint_gr))
19869 allocate(iscpend_nucl(nres,maxint_gr))
19870 !(maxres,maxint_gr)
19871 allocate(ielstart_vdw_nucl(nres))
19872 allocate(ielend_vdw_nucl(nres))
19874 allocate(lentyp(0:nfgtasks-1))
19876 !----------------------
19878 ! common /contacts/
19879 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
19880 allocate(icont(2,maxcont))
19882 ! common /contacts1/
19883 allocate(num_cont(0:nres+4))
19885 allocate(jcont(maxconts,nres))
19887 allocate(facont(maxconts,nres))
19889 allocate(gacont(3,maxconts,nres))
19890 !(3,maxconts,maxres)
19891 ! common /contacts_hb/
19892 allocate(gacontp_hb1(3,maxconts,nres))
19893 allocate(gacontp_hb2(3,maxconts,nres))
19894 allocate(gacontp_hb3(3,maxconts,nres))
19895 allocate(gacontm_hb1(3,maxconts,nres))
19896 allocate(gacontm_hb2(3,maxconts,nres))
19897 allocate(gacontm_hb3(3,maxconts,nres))
19898 allocate(gacont_hbr(3,maxconts,nres))
19899 allocate(grij_hb_cont(3,maxconts,nres))
19900 !(3,maxconts,maxres)
19901 allocate(facont_hb(maxconts,nres))
19903 allocate(ees0p(maxconts,nres))
19904 allocate(ees0m(maxconts,nres))
19905 allocate(d_cont(maxconts,nres))
19906 allocate(ees0plist(maxconts,nres))
19909 allocate(num_cont_hb(nres))
19911 allocate(jcont_hb(maxconts,nres))
19914 allocate(Ug(2,2,nres))
19915 allocate(Ugder(2,2,nres))
19916 allocate(Ug2(2,2,nres))
19917 allocate(Ug2der(2,2,nres))
19919 allocate(obrot(2,nres))
19920 allocate(obrot2(2,nres))
19921 allocate(obrot_der(2,nres))
19922 allocate(obrot2_der(2,nres))
19924 ! common /precomp1/
19925 allocate(mu(2,nres))
19926 allocate(muder(2,nres))
19927 allocate(Ub2(2,nres))
19930 allocate(Ub2der(2,nres))
19931 allocate(Ctobr(2,nres))
19932 allocate(Ctobrder(2,nres))
19933 allocate(Dtobr2(2,nres))
19934 allocate(Dtobr2der(2,nres))
19936 allocate(EUg(2,2,nres))
19937 allocate(EUgder(2,2,nres))
19938 allocate(CUg(2,2,nres))
19939 allocate(CUgder(2,2,nres))
19940 allocate(DUg(2,2,nres))
19941 allocate(Dugder(2,2,nres))
19942 allocate(DtUg2(2,2,nres))
19943 allocate(DtUg2der(2,2,nres))
19945 ! common /precomp2/
19946 allocate(Ug2Db1t(2,nres))
19947 allocate(Ug2Db1tder(2,nres))
19948 allocate(CUgb2(2,nres))
19949 allocate(CUgb2der(2,nres))
19951 allocate(EUgC(2,2,nres))
19952 allocate(EUgCder(2,2,nres))
19953 allocate(EUgD(2,2,nres))
19954 allocate(EUgDder(2,2,nres))
19955 allocate(DtUg2EUg(2,2,nres))
19956 allocate(Ug2DtEUg(2,2,nres))
19958 allocate(Ug2DtEUgder(2,2,2,nres))
19959 allocate(DtUg2EUgder(2,2,2,nres))
19961 ! common /rotat_old/
19962 allocate(costab(nres))
19963 allocate(sintab(nres))
19964 allocate(costab2(nres))
19965 allocate(sintab2(nres))
19968 allocate(a_chuj(2,2,maxconts,nres))
19969 !(2,2,maxconts,maxres)(maxconts=maxres/4)
19970 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
19971 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
19972 ! common /contdistrib/
19973 allocate(ncont_sent(nres))
19974 allocate(ncont_recv(nres))
19976 allocate(iat_sent(nres))
19978 allocate(iint_sent(4,nres,nres))
19979 allocate(iint_sent_local(4,nres,nres))
19981 allocate(iturn3_sent(4,0:nres+4))
19982 allocate(iturn4_sent(4,0:nres+4))
19983 allocate(iturn3_sent_local(4,nres))
19984 allocate(iturn4_sent_local(4,nres))
19986 allocate(itask_cont_from(0:nfgtasks-1))
19987 allocate(itask_cont_to(0:nfgtasks-1))
19988 !(0:max_fg_procs-1)
19992 !----------------------
19995 allocate(dcdv(6,maxdim))
19996 allocate(dxdv(6,maxdim))
19998 allocate(dxds(6,nres))
20000 allocate(gradx(3,-1:nres,0:2))
20001 allocate(gradc(3,-1:nres,0:2))
20003 allocate(gvdwx(3,-1:nres))
20004 allocate(gvdwc(3,-1:nres))
20005 allocate(gelc(3,-1:nres))
20006 allocate(gelc_long(3,-1:nres))
20007 allocate(gvdwpp(3,-1:nres))
20008 allocate(gvdwc_scpp(3,-1:nres))
20009 allocate(gradx_scp(3,-1:nres))
20010 allocate(gvdwc_scp(3,-1:nres))
20011 allocate(ghpbx(3,-1:nres))
20012 allocate(ghpbc(3,-1:nres))
20013 allocate(gradcorr(3,-1:nres))
20014 allocate(gradcorr_long(3,-1:nres))
20015 allocate(gradcorr5_long(3,-1:nres))
20016 allocate(gradcorr6_long(3,-1:nres))
20017 allocate(gcorr6_turn_long(3,-1:nres))
20018 allocate(gradxorr(3,-1:nres))
20019 allocate(gradcorr5(3,-1:nres))
20020 allocate(gradcorr6(3,-1:nres))
20021 allocate(gliptran(3,-1:nres))
20022 allocate(gliptranc(3,-1:nres))
20023 allocate(gliptranx(3,-1:nres))
20024 allocate(gshieldx(3,-1:nres))
20025 allocate(gshieldc(3,-1:nres))
20026 allocate(gshieldc_loc(3,-1:nres))
20027 allocate(gshieldx_ec(3,-1:nres))
20028 allocate(gshieldc_ec(3,-1:nres))
20029 allocate(gshieldc_loc_ec(3,-1:nres))
20030 allocate(gshieldx_t3(3,-1:nres))
20031 allocate(gshieldc_t3(3,-1:nres))
20032 allocate(gshieldc_loc_t3(3,-1:nres))
20033 allocate(gshieldx_t4(3,-1:nres))
20034 allocate(gshieldc_t4(3,-1:nres))
20035 allocate(gshieldc_loc_t4(3,-1:nres))
20036 allocate(gshieldx_ll(3,-1:nres))
20037 allocate(gshieldc_ll(3,-1:nres))
20038 allocate(gshieldc_loc_ll(3,-1:nres))
20039 allocate(grad_shield(3,-1:nres))
20040 allocate(gg_tube_sc(3,-1:nres))
20041 allocate(gg_tube(3,-1:nres))
20042 allocate(gradafm(3,-1:nres))
20043 allocate(gradb_nucl(3,-1:nres))
20044 allocate(gradbx_nucl(3,-1:nres))
20045 allocate(gvdwpsb1(3,-1:nres))
20046 allocate(gelpp(3,-1:nres))
20047 allocate(gvdwpsb(3,-1:nres))
20048 allocate(gelsbc(3,-1:nres))
20049 allocate(gelsbx(3,-1:nres))
20050 allocate(gvdwsbx(3,-1:nres))
20051 allocate(gvdwsbc(3,-1:nres))
20052 allocate(gsbloc(3,-1:nres))
20053 allocate(gsblocx(3,-1:nres))
20054 allocate(gradcorr_nucl(3,-1:nres))
20055 allocate(gradxorr_nucl(3,-1:nres))
20056 allocate(gradcorr3_nucl(3,-1:nres))
20057 allocate(gradxorr3_nucl(3,-1:nres))
20058 allocate(gvdwpp_nucl(3,-1:nres))
20059 allocate(gradpepcat(3,-1:nres))
20060 allocate(gradpepcatx(3,-1:nres))
20061 allocate(gradcatcat(3,-1:nres))
20063 allocate(grad_shield_side(3,maxcontsshi,-1:nres))
20064 allocate(grad_shield_loc(3,maxcontsshi,-1:nres))
20065 ! grad for shielding surroing
20066 allocate(gloc(0:maxvar,0:2))
20067 allocate(gloc_x(0:maxvar,2))
20069 allocate(gel_loc(3,-1:nres))
20070 allocate(gel_loc_long(3,-1:nres))
20071 allocate(gcorr3_turn(3,-1:nres))
20072 allocate(gcorr4_turn(3,-1:nres))
20073 allocate(gcorr6_turn(3,-1:nres))
20074 allocate(gradb(3,-1:nres))
20075 allocate(gradbx(3,-1:nres))
20077 allocate(gel_loc_loc(maxvar))
20078 allocate(gel_loc_turn3(maxvar))
20079 allocate(gel_loc_turn4(maxvar))
20080 allocate(gel_loc_turn6(maxvar))
20081 allocate(gcorr_loc(maxvar))
20082 allocate(g_corr5_loc(maxvar))
20083 allocate(g_corr6_loc(maxvar))
20085 allocate(gsccorc(3,-1:nres))
20086 allocate(gsccorx(3,-1:nres))
20088 allocate(gsccor_loc(-1:nres))
20090 allocate(gvdwx_scbase(3,-1:nres))
20091 allocate(gvdwc_scbase(3,-1:nres))
20092 allocate(gvdwx_pepbase(3,-1:nres))
20093 allocate(gvdwc_pepbase(3,-1:nres))
20094 allocate(gvdwx_scpho(3,-1:nres))
20095 allocate(gvdwc_scpho(3,-1:nres))
20096 allocate(gvdwc_peppho(3,-1:nres))
20098 allocate(dtheta(3,2,-1:nres))
20100 allocate(gscloc(3,-1:nres))
20101 allocate(gsclocx(3,-1:nres))
20103 allocate(dphi(3,3,-1:nres))
20104 allocate(dalpha(3,3,-1:nres))
20105 allocate(domega(3,3,-1:nres))
20107 ! common /deriv_scloc/
20108 allocate(dXX_C1tab(3,nres))
20109 allocate(dYY_C1tab(3,nres))
20110 allocate(dZZ_C1tab(3,nres))
20111 allocate(dXX_Ctab(3,nres))
20112 allocate(dYY_Ctab(3,nres))
20113 allocate(dZZ_Ctab(3,nres))
20114 allocate(dXX_XYZtab(3,nres))
20115 allocate(dYY_XYZtab(3,nres))
20116 allocate(dZZ_XYZtab(3,nres))
20119 allocate(jgrad_start(nres))
20120 allocate(jgrad_end(nres))
20122 !----------------------
20125 allocate(ibond_displ(0:nfgtasks-1))
20126 allocate(ibond_count(0:nfgtasks-1))
20127 allocate(ithet_displ(0:nfgtasks-1))
20128 allocate(ithet_count(0:nfgtasks-1))
20129 allocate(iphi_displ(0:nfgtasks-1))
20130 allocate(iphi_count(0:nfgtasks-1))
20131 allocate(iphi1_displ(0:nfgtasks-1))
20132 allocate(iphi1_count(0:nfgtasks-1))
20133 allocate(ivec_displ(0:nfgtasks-1))
20134 allocate(ivec_count(0:nfgtasks-1))
20135 allocate(iset_displ(0:nfgtasks-1))
20136 allocate(iset_count(0:nfgtasks-1))
20137 allocate(iint_count(0:nfgtasks-1))
20138 allocate(iint_displ(0:nfgtasks-1))
20139 !(0:max_fg_procs-1)
20140 !----------------------
20143 allocate(gcart(3,-1:nres))
20144 allocate(gxcart(3,-1:nres))
20146 allocate(gradcag(3,-1:nres))
20147 allocate(gradxag(3,-1:nres))
20149 ! common /back_constr/
20150 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
20151 allocate(dutheta(nres))
20152 allocate(dugamma(nres))
20154 allocate(duscdiff(3,nres))
20155 allocate(duscdiffx(3,nres))
20157 !el i io:read_fragments
20158 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
20159 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
20161 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
20162 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
20163 allocate(mset(0:nprocs)) !(maxprocs/20)
20165 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
20166 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
20167 allocate(dUdconst(3,0:nres))
20168 allocate(dUdxconst(3,0:nres))
20169 allocate(dqwol(3,0:nres))
20170 allocate(dxqwol(3,0:nres))
20172 !----------------------
20174 ! common /sbridge/ in io_common: read_bridge
20175 !el allocate((:),allocatable :: iss !(maxss)
20176 ! common /links/ in io_common: read_bridge
20177 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
20178 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
20179 ! common /dyn_ssbond/
20180 ! and side-chain vectors in theta or phi.
20181 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
20185 dyn_ssbond_ij(:,:)=1.0d300
20189 ! if (nss.gt.0) then
20190 allocate(idssb(maxdim),jdssb(maxdim))
20191 ! allocate(newihpb(nss),newjhpb(nss))
20194 allocate(ishield_list(-1:nres))
20195 allocate(shield_list(maxcontsshi,-1:nres))
20196 allocate(dyn_ss_mask(nres))
20197 allocate(fac_shield(-1:nres))
20198 allocate(enetube(nres*2))
20199 allocate(enecavtube(nres*2))
20202 dyn_ss_mask(:)=.false.
20203 !----------------------
20205 ! Parameters of the SCCOR term
20207 !el in io_conf: parmread
20208 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
20209 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
20210 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
20211 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
20212 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
20213 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
20214 ! allocate(vlor1sccor(maxterm_sccor,20,20))
20215 ! allocate(vlor2sccor(maxterm_sccor,20,20))
20216 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
20218 allocate(gloc_sc(3,0:2*nres,0:10))
20219 !(3,0:maxres2,10)maxres2=2*maxres
20220 allocate(dcostau(3,3,3,2*nres))
20221 allocate(dsintau(3,3,3,2*nres))
20222 allocate(dtauangle(3,3,3,2*nres))
20223 allocate(dcosomicron(3,3,3,2*nres))
20224 allocate(domicron(3,3,3,2*nres))
20225 !(3,3,3,maxres2)maxres2=2*maxres
20226 !----------------------
20229 allocate(varall(maxvar))
20230 !(maxvar)(maxvar=6*maxres)
20231 allocate(mask_theta(nres))
20232 allocate(mask_phi(nres))
20233 allocate(mask_side(nres))
20235 !----------------------
20238 allocate(uy(3,nres))
20239 allocate(uz(3,nres))
20241 allocate(uygrad(3,3,2,nres))
20242 allocate(uzgrad(3,3,2,nres))
20246 end subroutine alloc_ener_arrays
20247 !-----------------------------------------------------------------
20248 subroutine ebond_nucl(estr_nucl)
20250 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
20253 real(kind=8),dimension(3) :: u,ud
20254 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
20255 real(kind=8) :: estr_nucl,diff
20256 integer :: iti,i,j,k,nbi
20258 !C print *,"I enter ebond"
20260 write (iout,*) "ibondp_start,ibondp_end",&
20261 ibondp_nucl_start,ibondp_nucl_end
20262 do i=ibondp_nucl_start,ibondp_nucl_end
20263 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
20264 itype(i,2).eq.ntyp1_molec(2)) cycle
20265 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
20267 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
20268 ! & *dc(j,i-1)/vbld(i)
20270 ! if (energy_dec) write(iout,*)
20271 ! & "estr1",i,vbld(i),distchainmax,
20272 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
20274 diff = vbld(i)-vbldp0_nucl
20275 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
20276 vbldp0_nucl,diff,AKP_nucl*diff*diff
20277 estr_nucl=estr_nucl+diff*diff
20278 ! print *,estr_nucl
20280 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
20282 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
20284 estr_nucl=0.5d0*AKP_nucl*estr_nucl
20285 ! print *,"partial sum", estr_nucl,AKP_nucl
20288 write (iout,*) "ibondp_start,ibondp_end",&
20289 ibond_nucl_start,ibond_nucl_end
20291 do i=ibond_nucl_start,ibond_nucl_end
20292 !C print *, "I am stuck",i
20294 if (iti.eq.ntyp1_molec(2)) cycle
20295 nbi=nbondterm_nucl(iti)
20298 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
20301 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
20302 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
20303 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
20304 ! print *,estr_nucl
20306 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
20310 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
20311 ud(j)=aksc_nucl(j,iti)*diff
20312 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
20326 uprod2=uprod2*u(k)*u(k)
20330 usumsqder=usumsqder+ud(j)*uprod2
20332 estr_nucl=estr_nucl+uprod/usum
20334 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
20338 !C print *,"I am about to leave ebond"
20340 end subroutine ebond_nucl
20342 !-----------------------------------------------------------------------------
20343 subroutine ebend_nucl(etheta_nucl)
20344 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
20345 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
20346 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
20347 logical :: lprn=.false., lprn1=.false.
20348 !el local variables
20349 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
20350 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
20351 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
20352 ! local variables for constrains
20353 real(kind=8) :: difi,thetiii
20356 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
20357 do i=ithet_nucl_start,ithet_nucl_end
20358 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
20359 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
20360 (itype(i,2).eq.ntyp1_molec(2))) cycle
20364 theti2=0.5d0*theta(i)
20365 ityp2=ithetyp_nucl(itype(i-1,2))
20366 do k=1,nntheterm_nucl
20367 coskt(k)=dcos(k*theti2)
20368 sinkt(k)=dsin(k*theti2)
20370 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
20373 if (phii.ne.phii) phii=150.0
20377 ityp1=ithetyp_nucl(itype(i-2,2))
20378 do k=1,nsingle_nucl
20379 cosph1(k)=dcos(k*phii)
20380 sinph1(k)=dsin(k*phii)
20384 ityp1=nthetyp_nucl+1
20385 do k=1,nsingle_nucl
20391 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
20394 if (phii1.ne.phii1) phii1=150.0
20395 phii1=pinorm(phii1)
20399 ityp3=ithetyp_nucl(itype(i,2))
20400 do k=1,nsingle_nucl
20401 cosph2(k)=dcos(k*phii1)
20402 sinph2(k)=dsin(k*phii1)
20406 ityp3=nthetyp_nucl+1
20407 do k=1,nsingle_nucl
20412 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
20413 do k=1,ndouble_nucl
20415 ccl=cosph1(l)*cosph2(k-l)
20416 ssl=sinph1(l)*sinph2(k-l)
20417 scl=sinph1(l)*cosph2(k-l)
20418 csl=cosph1(l)*sinph2(k-l)
20419 cosph1ph2(l,k)=ccl-ssl
20420 cosph1ph2(k,l)=ccl+ssl
20421 sinph1ph2(l,k)=scl+csl
20422 sinph1ph2(k,l)=scl-csl
20426 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
20427 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
20428 write (iout,*) "coskt and sinkt",nntheterm_nucl
20429 do k=1,nntheterm_nucl
20430 write (iout,*) k,coskt(k),sinkt(k)
20433 do k=1,ntheterm_nucl
20434 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
20435 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
20438 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
20442 write (iout,*) "cosph and sinph"
20443 do k=1,nsingle_nucl
20444 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
20446 write (iout,*) "cosph1ph2 and sinph2ph2"
20447 do k=2,ndouble_nucl
20449 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
20450 sinph1ph2(l,k),sinph1ph2(k,l)
20453 write(iout,*) "ethetai",ethetai
20455 do m=1,ntheterm2_nucl
20456 do k=1,nsingle_nucl
20457 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
20458 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
20459 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
20460 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
20461 ethetai=ethetai+sinkt(m)*aux
20462 dethetai=dethetai+0.5d0*m*aux*coskt(m)
20463 dephii=dephii+k*sinkt(m)*(&
20464 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
20465 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
20466 dephii1=dephii1+k*sinkt(m)*(&
20467 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
20468 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
20470 write (iout,*) "m",m," k",k," bbthet",&
20471 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
20472 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
20473 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
20474 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20478 write(iout,*) "ethetai",ethetai
20479 do m=1,ntheterm3_nucl
20480 do k=2,ndouble_nucl
20482 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20483 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
20484 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20485 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
20486 ethetai=ethetai+sinkt(m)*aux
20487 dethetai=dethetai+0.5d0*m*coskt(m)*aux
20488 dephii=dephii+l*sinkt(m)*(&
20489 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
20490 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20491 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20492 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20493 dephii1=dephii1+(k-l)*sinkt(m)*( &
20494 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20495 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20496 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
20497 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20499 write (iout,*) "m",m," k",k," l",l," ffthet", &
20500 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
20501 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
20502 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
20503 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20504 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
20505 cosph1ph2(k,l)*sinkt(m),&
20506 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
20512 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
20513 i,theta(i)*rad2deg,phii*rad2deg, &
20514 phii1*rad2deg,ethetai
20515 etheta_nucl=etheta_nucl+ethetai
20516 ! print *,i,"partial sum",etheta_nucl
20517 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
20518 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
20519 gloc(nphi+i-2,icg)=wang_nucl*dethetai
20522 end subroutine ebend_nucl
20523 !----------------------------------------------------
20524 subroutine etor_nucl(etors_nucl)
20525 ! implicit real*8 (a-h,o-z)
20526 ! include 'DIMENSIONS'
20527 ! include 'COMMON.VAR'
20528 ! include 'COMMON.GEO'
20529 ! include 'COMMON.LOCAL'
20530 ! include 'COMMON.TORSION'
20531 ! include 'COMMON.INTERACT'
20532 ! include 'COMMON.DERIV'
20533 ! include 'COMMON.CHAIN'
20534 ! include 'COMMON.NAMES'
20535 ! include 'COMMON.IOUNITS'
20536 ! include 'COMMON.FFIELD'
20537 ! include 'COMMON.TORCNSTR'
20538 ! include 'COMMON.CONTROL'
20539 real(kind=8) :: etors_nucl,edihcnstr
20541 !el local variables
20542 integer :: i,j,iblock,itori,itori1
20543 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
20544 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
20545 ! Set lprn=.true. for debugging
20549 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
20550 do i=iphi_nucl_start,iphi_nucl_end
20551 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
20552 .or. itype(i-3,2).eq.ntyp1_molec(2) &
20553 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
20555 itori=itortyp_nucl(itype(i-2,2))
20556 itori1=itortyp_nucl(itype(i-1,2))
20558 ! print *,i,itori,itori1
20560 !C Regular cosine and sine terms
20561 do j=1,nterm_nucl(itori,itori1)
20562 v1ij=v1_nucl(j,itori,itori1)
20563 v2ij=v2_nucl(j,itori,itori1)
20564 cosphi=dcos(j*phii)
20565 sinphi=dsin(j*phii)
20566 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
20567 if (energy_dec) etors_ii=etors_ii+&
20568 v1ij*cosphi+v2ij*sinphi
20569 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
20573 !C E = SUM ----------------------------------- - v1
20574 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
20576 cosphi=dcos(0.5d0*phii)
20577 sinphi=dsin(0.5d0*phii)
20578 do j=1,nlor_nucl(itori,itori1)
20579 vl1ij=vlor1_nucl(j,itori,itori1)
20580 vl2ij=vlor2_nucl(j,itori,itori1)
20581 vl3ij=vlor3_nucl(j,itori,itori1)
20582 pom=vl2ij*cosphi+vl3ij*sinphi
20583 pom1=1.0d0/(pom*pom+1.0d0)
20584 etors_nucl=etors_nucl+vl1ij*pom1
20585 if (energy_dec) etors_ii=etors_ii+ &
20588 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
20590 !C Subtract the constant term
20591 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
20592 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
20593 'etor',i,etors_ii-v0_nucl(itori,itori1)
20595 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
20596 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
20597 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
20598 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
20599 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
20602 end subroutine etor_nucl
20603 !------------------------------------------------------------
20604 subroutine epp_nucl_sub(evdw1,ees)
20606 !C This subroutine calculates the average interaction energy and its gradient
20607 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
20608 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
20609 !C The potential depends both on the distance of peptide-group centers and on
20610 !C the orientation of the CA-CA virtual bonds.
20612 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
20613 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
20614 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
20615 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
20616 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
20617 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20618 dist_temp, dist_init,sss_grad,fac,evdw1ij
20619 integer xshift,yshift,zshift
20620 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
20621 real(kind=8) :: ees,eesij
20622 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20623 real(kind=8) scal_el /0.5d0/
20629 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
20631 ! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
20632 do i=iatel_s_nucl,iatel_e_nucl
20633 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20637 dx_normi=dc_norm(1,i)
20638 dy_normi=dc_norm(2,i)
20639 dz_normi=dc_norm(3,i)
20640 xmedi=c(1,i)+0.5d0*dxi
20641 ymedi=c(2,i)+0.5d0*dyi
20642 zmedi=c(3,i)+0.5d0*dzi
20643 xmedi=dmod(xmedi,boxxsize)
20644 if (xmedi.lt.0) xmedi=xmedi+boxxsize
20645 ymedi=dmod(ymedi,boxysize)
20646 if (ymedi.lt.0) ymedi=ymedi+boxysize
20647 zmedi=dmod(zmedi,boxzsize)
20648 if (zmedi.lt.0) zmedi=zmedi+boxzsize
20650 do j=ielstart_nucl(i),ielend_nucl(i)
20651 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
20656 ! xj=c(1,j)+0.5D0*dxj-xmedi
20657 ! yj=c(2,j)+0.5D0*dyj-ymedi
20658 ! zj=c(3,j)+0.5D0*dzj-zmedi
20659 xj=c(1,j)+0.5D0*dxj
20660 yj=c(2,j)+0.5D0*dyj
20661 zj=c(3,j)+0.5D0*dzj
20662 xj=mod(xj,boxxsize)
20663 if (xj.lt.0) xj=xj+boxxsize
20664 yj=mod(yj,boxysize)
20665 if (yj.lt.0) yj=yj+boxysize
20666 zj=mod(zj,boxzsize)
20667 if (zj.lt.0) zj=zj+boxzsize
20669 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20676 xj=xj_safe+xshift*boxxsize
20677 yj=yj_safe+yshift*boxysize
20678 zj=zj_safe+zshift*boxzsize
20679 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20680 if(dist_temp.lt.dist_init) then
20681 dist_init=dist_temp
20690 if (isubchap.eq.1) then
20701 rij=xj*xj+yj*yj+zj*zj
20702 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
20703 fac=(r0pp**2/rij)**3
20707 fac=(-ev1-evdw1ij)/rij
20708 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
20709 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
20710 evdw1=evdw1+evdw1ij
20712 !C Calculate contributions to the Cartesian gradient.
20718 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
20719 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
20721 !c phoshate-phosphate electrostatic interactions
20724 eesij=dexp(-BEES*rij)*fac
20725 ! write (2,*)"fac",fac," eesijpp",eesij
20726 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
20729 fac=-(fac+BEES)*eesij*fac
20733 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
20734 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
20735 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
20737 gelpp(k,i)=gelpp(k,i)-ggg(k)
20738 gelpp(k,j)=gelpp(k,j)+ggg(k)
20745 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20747 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
20748 !c gelpp(k,i)=332.0d0*gelpp(k,i)
20749 gelpp(k,i)=AEES*gelpp(k,i)
20751 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20753 !c write (2,*) "total EES",ees
20755 end subroutine epp_nucl_sub
20756 !---------------------------------------------------------------------
20757 subroutine epsb(evdwpsb,eelpsb)
20760 !C This subroutine calculates the excluded-volume interaction energy between
20761 !C peptide-group centers and side chains and its gradient in virtual-bond and
20762 !C side-chain vectors.
20764 real(kind=8),dimension(3):: ggg
20765 integer :: i,iint,j,k,iteli,itypj,subchap
20766 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
20767 e1,e2,evdwij,rij,evdwpsb,eelpsb
20768 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20769 dist_temp, dist_init
20770 integer xshift,yshift,zshift
20772 !cd print '(a)','Enter ESCP'
20773 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
20776 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
20777 do i=iatscp_s_nucl,iatscp_e_nucl
20778 if (itype(i,2).eq.ntyp1_molec(2) &
20779 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20780 xi=0.5D0*(c(1,i)+c(1,i+1))
20781 yi=0.5D0*(c(2,i)+c(2,i+1))
20782 zi=0.5D0*(c(3,i)+c(3,i+1))
20783 xi=mod(xi,boxxsize)
20784 if (xi.lt.0) xi=xi+boxxsize
20785 yi=mod(yi,boxysize)
20786 if (yi.lt.0) yi=yi+boxysize
20787 zi=mod(zi,boxzsize)
20788 if (zi.lt.0) zi=zi+boxzsize
20790 do iint=1,nscp_gr_nucl(i)
20792 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
20794 if (itypj.eq.ntyp1_molec(2)) cycle
20795 !C Uncomment following three lines for SC-p interactions
20796 !c xj=c(1,nres+j)-xi
20797 !c yj=c(2,nres+j)-yi
20798 !c zj=c(3,nres+j)-zi
20799 !C Uncomment following three lines for Ca-p interactions
20806 xj=mod(xj,boxxsize)
20807 if (xj.lt.0) xj=xj+boxxsize
20808 yj=mod(yj,boxysize)
20809 if (yj.lt.0) yj=yj+boxysize
20810 zj=mod(zj,boxzsize)
20811 if (zj.lt.0) zj=zj+boxzsize
20812 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20820 xj=xj_safe+xshift*boxxsize
20821 yj=yj_safe+yshift*boxysize
20822 zj=zj_safe+zshift*boxzsize
20823 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20824 if(dist_temp.lt.dist_init) then
20825 dist_init=dist_temp
20834 if (subchap.eq.1) then
20844 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20846 e1=fac*fac*aad_nucl(itypj)
20847 e2=fac*bad_nucl(itypj)
20848 if (iabs(j-i) .le. 2) then
20853 evdwpsb=evdwpsb+evdwij
20854 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
20855 'evdw2',i,j,evdwij,"tu4"
20857 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
20859 fac=-(evdwij+e1)*rrij
20864 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
20865 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
20873 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
20874 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
20878 end subroutine epsb
20880 !------------------------------------------------------
20881 subroutine esb_gb(evdwsb,eelsb)
20884 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
20885 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
20886 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
20887 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20888 dist_temp, dist_init,aa,bb,faclip,sig0ij
20897 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
20898 do i=iatsc_s_nucl,iatsc_e_nucl
20902 ! PRINT *,"I=",i,itypi
20903 if (itypi.eq.ntyp1_molec(2)) cycle
20904 itypi1=itype(i+1,2)
20908 xi=dmod(xi,boxxsize)
20909 if (xi.lt.0) xi=xi+boxxsize
20910 yi=dmod(yi,boxysize)
20911 if (yi.lt.0) yi=yi+boxysize
20912 zi=dmod(zi,boxzsize)
20913 if (zi.lt.0) zi=zi+boxzsize
20915 dxi=dc_norm(1,nres+i)
20916 dyi=dc_norm(2,nres+i)
20917 dzi=dc_norm(3,nres+i)
20918 dsci_inv=vbld_inv(i+nres)
20920 !C Calculate SC interaction energy.
20922 do iint=1,nint_gr_nucl(i)
20923 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
20924 do j=istart_nucl(i,iint),iend_nucl(i,iint)
20928 if (itypj.eq.ntyp1_molec(2)) cycle
20929 dscj_inv=vbld_inv(j+nres)
20930 sig0ij=sigma_nucl(itypi,itypj)
20931 chi1=chi_nucl(itypi,itypj)
20932 chi2=chi_nucl(itypj,itypi)
20934 chip1=chip_nucl(itypi,itypj)
20935 chip2=chip_nucl(itypj,itypi)
20937 ! xj=c(1,nres+j)-xi
20938 ! yj=c(2,nres+j)-yi
20939 ! zj=c(3,nres+j)-zi
20943 xj=dmod(xj,boxxsize)
20944 if (xj.lt.0) xj=xj+boxxsize
20945 yj=dmod(yj,boxysize)
20946 if (yj.lt.0) yj=yj+boxysize
20947 zj=dmod(zj,boxzsize)
20948 if (zj.lt.0) zj=zj+boxzsize
20949 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20957 xj=xj_safe+xshift*boxxsize
20958 yj=yj_safe+yshift*boxysize
20959 zj=zj_safe+zshift*boxzsize
20960 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20961 if(dist_temp.lt.dist_init) then
20962 dist_init=dist_temp
20971 if (subchap.eq.1) then
20981 dxj=dc_norm(1,nres+j)
20982 dyj=dc_norm(2,nres+j)
20983 dzj=dc_norm(3,nres+j)
20984 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20986 !C Calculate angle-dependent terms of energy and contributions to their
20991 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
20992 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
20993 om12=dxi*dxj+dyi*dyj+dzi*dzj
20994 call sc_angular_nucl
20996 sig=sig0ij*dsqrt(sigsq)
20997 rij_shift=1.0D0/rij-sig+sig0ij
20998 ! print *,rij_shift,"rij_shift"
20999 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
21000 !c & " rij_shift",rij_shift
21001 if (rij_shift.le.0.0D0) then
21006 !c---------------------------------------------------------------
21007 rij_shift=1.0D0/rij_shift
21008 fac=rij_shift**expon
21009 e1=fac*fac*aa_nucl(itypi,itypj)
21010 e2=fac*bb_nucl(itypi,itypj)
21011 evdwij=eps1*eps2rt*(e1+e2)
21012 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
21013 !c & " e1",e1," e2",e2," evdwij",evdwij
21015 evdwij=evdwij*eps2rt
21016 evdwsb=evdwsb+evdwij
21018 sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
21019 epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
21020 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
21021 restyp(itypi,2),i,restyp(itypj,2),j, &
21022 epsi,sigm,chi1,chi2,chip1,chip2, &
21023 eps1,eps2rt**2,sig,sig0ij, &
21024 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
21026 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
21029 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
21030 'evdw',i,j,evdwij,"tu3"
21033 !C Calculate gradient components.
21034 e1=e1*eps1*eps2rt**2
21035 fac=-expon*(e1+evdwij)*rij_shift
21039 !C Calculate the radial part of the gradient
21043 !C Calculate angular part of the gradient.
21045 call eelsbij(eelij,num_conti2)
21046 if (energy_dec .and. &
21047 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
21048 write (istat,'(e14.5)') evdwij
21052 num_cont_hb(i)=num_conti2
21054 !c write (iout,*) "Number of loop steps in EGB:",ind
21055 !cccc energy_dec=.false.
21057 end subroutine esb_gb
21058 !-------------------------------------------------------------------------------
21059 subroutine eelsbij(eesij,num_conti2)
21062 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
21063 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
21064 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21065 dist_temp, dist_init,rlocshield,fracinbuf
21066 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
21068 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
21069 real(kind=8) scal_el /0.5d0/
21070 integer :: iteli,itelj,kkk,kkll,m,isubchap
21071 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
21072 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
21073 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
21074 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
21075 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
21076 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
21077 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
21078 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
21079 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
21080 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
21084 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
21085 ael6i=ael6_nucl(itypi,itypj)
21086 ael3i=ael3_nucl(itypi,itypj)
21087 ael63i=ael63_nucl(itypi,itypj)
21088 ael32i=ael32_nucl(itypi,itypj)
21089 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
21090 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
21094 dx_normi=dc_norm(1,i+nres)
21095 dy_normi=dc_norm(2,i+nres)
21096 dz_normi=dc_norm(3,i+nres)
21097 dx_normj=dc_norm(1,j+nres)
21098 dy_normj=dc_norm(2,j+nres)
21099 dz_normj=dc_norm(3,j+nres)
21100 !c xj=c(1,j)+0.5D0*dxj-xmedi
21101 !c yj=c(2,j)+0.5D0*dyj-ymedi
21102 !c zj=c(3,j)+0.5D0*dzj-zmedi
21103 if (ipot_nucl.ne.2) then
21104 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
21105 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
21106 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
21114 fac=cosa-3.0D0*cosb*cosg
21116 fac1=3.0d0*(cosb*cosb+cosg*cosg)
21121 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
21122 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
21123 el1=fac3*(4.0D0+facfac-fac1)
21125 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
21127 eesij=el1+el2+el3+el4
21128 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
21129 ees0ij=4.0D0+facfac-fac1
21131 if (energy_dec) then
21132 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
21133 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
21134 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
21135 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
21136 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
21137 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
21141 !C Calculate contributions to the Cartesian gradient.
21143 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
21149 !* Radial derivatives. First process both termini of the fragment (i,j)
21155 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
21156 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
21157 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
21158 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
21163 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
21168 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
21170 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
21173 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
21174 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
21177 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
21180 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
21181 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
21182 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21183 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
21184 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21185 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21186 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
21187 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
21189 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
21190 IF ( j.gt.i+1 .and.&
21191 num_conti.le.maxconts) THEN
21193 !C Calculate the contact function. The ith column of the array JCONT will
21194 !C contain the numbers of atoms that make contacts with the atom I (of numbers
21195 !C greater than I). The arrays FACONT and GACONT will contain the values of
21196 !C the contact function and its derivative.
21197 r0ij=2.20D0*sigma(itypi,itypj)
21198 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
21199 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
21200 !c write (2,*) "fcont",fcont
21201 if (fcont.gt.0.0D0) then
21202 num_conti=num_conti+1
21203 num_conti2=num_conti2+1
21205 if (num_conti.gt.maxconts) then
21206 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
21207 ' will skip next contacts for this conf.'
21209 jcont_hb(num_conti,i)=j
21210 !c write (iout,*) "num_conti",num_conti,
21211 !c & " jcont_hb",jcont_hb(num_conti,i)
21212 !C Calculate contact energies
21214 wij=cosa-3.0D0*cosb*cosg
21217 fac3=dsqrt(-ael6i)*r3ij
21218 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
21219 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
21220 if (ees0tmp.gt.0) then
21221 ees0pij=dsqrt(ees0tmp)
21225 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
21226 if (ees0tmp.gt.0) then
21227 ees0mij=dsqrt(ees0tmp)
21231 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
21232 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
21233 !c write (iout,*) "i",i," j",j,
21234 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
21235 ees0pij1=fac3/ees0pij
21236 ees0mij1=fac3/ees0mij
21237 fac3p=-3.0D0*fac3*rrij
21238 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
21239 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
21240 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
21241 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
21242 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
21243 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
21244 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
21245 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
21246 ecosap=ecosa1+ecosa2
21247 ecosbp=ecosb1+ecosb2
21248 ecosgp=ecosg1+ecosg2
21249 ecosam=ecosa1-ecosa2
21250 ecosbm=ecosb1-ecosb2
21251 ecosgm=ecosg1-ecosg2
21253 facont_hb(num_conti,i)=fcont
21254 fprimcont=fprimcont/rij
21256 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
21257 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
21259 gggp(1)=gggp(1)+ees0pijp*xj
21260 gggp(2)=gggp(2)+ees0pijp*yj
21261 gggp(3)=gggp(3)+ees0pijp*zj
21262 gggm(1)=gggm(1)+ees0mijp*xj
21263 gggm(2)=gggm(2)+ees0mijp*yj
21264 gggm(3)=gggm(3)+ees0mijp*zj
21265 !C Derivatives due to the contact function
21266 gacont_hbr(1,num_conti,i)=fprimcont*xj
21267 gacont_hbr(2,num_conti,i)=fprimcont*yj
21268 gacont_hbr(3,num_conti,i)=fprimcont*zj
21271 !c Gradient of the correlation terms
21273 gacontp_hb1(k,num_conti,i)= &
21274 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21275 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21276 gacontp_hb2(k,num_conti,i)= &
21277 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
21278 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21279 gacontp_hb3(k,num_conti,i)=gggp(k)
21280 gacontm_hb1(k,num_conti,i)= &
21281 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21282 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21283 gacontm_hb2(k,num_conti,i)= &
21284 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21285 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21286 gacontm_hb3(k,num_conti,i)=gggm(k)
21292 end subroutine eelsbij
21293 !------------------------------------------------------------------
21294 subroutine sc_grad_nucl
21297 real(kind=8),dimension(3) :: dcosom1,dcosom2
21298 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
21299 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
21300 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
21302 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
21303 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
21306 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
21309 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
21310 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
21311 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
21312 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
21313 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
21314 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
21317 !C Calculate the components of the gradient in DC and X
21320 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
21321 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
21324 end subroutine sc_grad_nucl
21325 !-----------------------------------------------------------------------
21326 subroutine esb(esbloc)
21327 !C Calculate the local energy of a side chain and its derivatives in the
21328 !C corresponding virtual-bond valence angles THETA and the spherical angles
21329 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
21330 !C added by Urszula Kozlowska. 07/11/2007
21332 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
21333 real(kind=8),dimension(9):: x
21334 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
21335 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
21336 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
21337 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
21338 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
21339 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
21340 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
21341 integer::it,nlobit,i,j,k
21342 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
21345 do i=loc_start_nucl,loc_end_nucl
21346 if (itype(i,2).eq.ntyp1_molec(2)) cycle
21347 costtab(i+1) =dcos(theta(i+1))
21348 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
21349 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
21350 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
21351 cosfac2=0.5d0/(1.0d0+costtab(i+1))
21352 cosfac=dsqrt(cosfac2)
21353 sinfac2=0.5d0/(1.0d0-costtab(i+1))
21354 sinfac=dsqrt(sinfac2)
21356 if (it.eq.10) goto 1
21359 !C Compute the axes of tghe local cartesian coordinates system; store in
21360 !c x_prime, y_prime and z_prime
21367 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
21368 !C & dc_norm(3,i+nres)
21370 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
21371 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
21374 z_prime(j) = -uz(j,i-1)
21382 xx = xx + x_prime(j)*dc_norm(j,i+nres)
21383 yy = yy + y_prime(j)*dc_norm(j,i+nres)
21384 zz = zz + z_prime(j)*dc_norm(j,i+nres)
21392 x(j) = sc_parmin_nucl(j,it)
21395 !Cc diagnostics - remove later
21396 xx1 = dcos(alph(2))
21397 yy1 = dsin(alph(2))*dcos(omeg(2))
21398 zz1 = -dsin(alph(2))*dsin(omeg(2))
21399 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
21400 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
21402 !C," --- ", xx_w,yy_w,zz_w
21405 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21406 esbloc = esbloc + sumene
21407 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
21408 ! print *,"enecomp",sumene,sumene2
21409 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
21410 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
21412 write (2,*) "x",(x(k),k=1,9)
21414 !C This section to check the numerical derivatives of the energy of ith side
21415 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
21416 !C #define DEBUG in the code to turn it on.
21418 write (2,*) "sumene =",sumene
21422 write (2,*) xx,yy,zz
21423 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21424 de_dxx_num=(sumenep-sumene)/aincr
21426 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
21429 write (2,*) xx,yy,zz
21430 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21431 de_dyy_num=(sumenep-sumene)/aincr
21433 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
21436 write (2,*) xx,yy,zz
21437 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21438 de_dzz_num=(sumenep-sumene)/aincr
21440 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
21441 costsave=cost2tab(i+1)
21442 sintsave=sint2tab(i+1)
21443 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
21444 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
21445 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21446 de_dt_num=(sumenep-sumene)/aincr
21447 write (2,*) " t+ sumene from enesc=",sumenep,sumene
21448 cost2tab(i+1)=costsave
21449 sint2tab(i+1)=sintsave
21450 !C End of diagnostics section.
21453 !C Compute the gradient of esc
21455 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
21456 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
21457 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
21460 write (2,*) "x",(x(k),k=1,9)
21461 write (2,*) "xx",xx," yy",yy," zz",zz
21462 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
21463 " de_zz ",de_zz," de_tt ",de_tt
21464 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
21465 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
21468 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
21469 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
21470 cosfac2xx=cosfac2*xx
21471 sinfac2yy=sinfac2*yy
21473 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
21475 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
21477 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
21478 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
21479 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
21480 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
21481 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
21482 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
21483 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
21484 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
21485 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
21486 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
21490 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
21491 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
21494 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
21495 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
21496 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
21498 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
21499 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
21503 dXX_Ctab(k,i)=dXX_Ci(k)
21504 dXX_C1tab(k,i)=dXX_Ci1(k)
21505 dYY_Ctab(k,i)=dYY_Ci(k)
21506 dYY_C1tab(k,i)=dYY_Ci1(k)
21507 dZZ_Ctab(k,i)=dZZ_Ci(k)
21508 dZZ_C1tab(k,i)=dZZ_Ci1(k)
21509 dXX_XYZtab(k,i)=dXX_XYZ(k)
21510 dYY_XYZtab(k,i)=dYY_XYZ(k)
21511 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
21514 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
21515 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
21516 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
21517 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
21518 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
21520 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
21521 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
21522 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
21523 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
21524 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
21525 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
21526 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
21527 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
21528 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
21530 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
21531 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
21533 !C to check gradient call subroutine check_grad
21539 !=-------------------------------------------------------
21540 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
21542 real(kind=8),dimension(9):: x(9)
21543 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
21544 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
21546 !c write (2,*) "enesc"
21547 !c write (2,*) "x",(x(i),i=1,9)
21548 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
21549 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
21550 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
21554 end function enesc_nucl
21555 !-----------------------------------------------------------------------------
21556 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
21559 integer,parameter :: max_cont=2000
21560 integer,parameter:: max_dim=2*(8*3+6)
21561 integer, parameter :: msglen1=max_cont*max_dim
21562 integer,parameter :: msglen2=2*msglen1
21563 integer source,CorrelType,CorrelID,Error
21564 real(kind=8) :: buffer(max_cont,max_dim)
21565 integer status(MPI_STATUS_SIZE)
21566 integer :: ierror,nbytes
21568 real(kind=8),dimension(3):: gx(3),gx1(3)
21569 real(kind=8) :: time00
21571 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
21572 real(kind=8) ecorr,ecorr3
21573 integer :: n_corr,n_corr1,mm,msglen
21574 !C Set lprn=.true. for debugging
21579 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
21581 if (nfgtasks.le.1) goto 30
21583 write (iout,'(a)') 'Contact function values:'
21585 write (iout,'(2i3,50(1x,i2,f5.2))') &
21586 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21587 j=1,num_cont_hb(i))
21590 !C Caution! Following code assumes that electrostatic interactions concerning
21591 !C a given atom are split among at most two processors!
21601 !c write (*,*) 'MyRank',MyRank,' mm',mm
21604 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
21605 if (fg_rank.gt.0) then
21606 !C Send correlation contributions to the preceding processor
21608 nn=num_cont_hb(iatel_s_nucl)
21609 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
21610 !c write (*,*) 'The BUFFER array:'
21612 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
21614 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
21616 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
21617 !C Clear the contacts of the atom passed to the neighboring processor
21618 nn=num_cont_hb(iatel_s_nucl+1)
21620 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
21622 num_cont_hb(iatel_s_nucl)=0
21624 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
21625 !cd & ' is sending correlation contribution to processor',fg_rank-1,
21626 !cd & ' msglen=',msglen
21627 !c write (*,*) 'Processor ',fg_rank,MyRank,
21628 !c & ' is sending correlation contribution to processor',fg_rank-1,
21629 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21631 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
21632 CorrelType,FG_COMM,IERROR)
21633 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21634 !cd write (iout,*) 'Processor ',fg_rank,
21635 !cd & ' has sent correlation contribution to processor',fg_rank-1,
21636 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
21637 !c write (*,*) 'Processor ',fg_rank,
21638 !c & ' has sent correlation contribution to processor',fg_rank-1,
21639 !c & ' msglen=',msglen,' CorrelID=',CorrelID
21641 endif ! (fg_rank.gt.0)
21645 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
21646 if (fg_rank.lt.nfgtasks-1) then
21647 !C Receive correlation contributions from the next processor
21649 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
21650 !cd write (iout,*) 'Processor',fg_rank,
21651 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
21652 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
21653 !c write (*,*) 'Processor',fg_rank,
21654 !c &' is receiving correlation contribution from processor',fg_rank+1,
21655 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21658 do while (nbytes.le.0)
21659 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21660 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
21662 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
21663 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
21664 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21665 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21666 !c write (*,*) 'Processor',fg_rank,
21667 !c &' has received correlation contribution from processor',fg_rank+1,
21668 !c & ' msglen=',msglen,' nbytes=',nbytes
21669 !c write (*,*) 'The received BUFFER array:'
21671 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
21673 if (msglen.eq.msglen1) then
21674 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
21675 else if (msglen.eq.msglen2) then
21676 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
21677 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
21680 'ERROR!!!! message length changed while processing correlations.'
21682 'ERROR!!!! message length changed while processing correlations.'
21683 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
21684 endif ! msglen.eq.msglen1
21685 endif ! fg_rank.lt.nfgtasks-1
21692 write (iout,'(a)') 'Contact function values:'
21693 do i=nnt_molec(2),nct_molec(2)-1
21694 write (iout,'(2i3,50(1x,i2,f5.2))') &
21695 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21696 j=1,num_cont_hb(i))
21701 !C Remove the loop below after debugging !!!
21702 ! do i=nnt_molec(2),nct_molec(2)
21704 ! gradcorr_nucl(j,i)=0.0D0
21705 ! gradxorr_nucl(j,i)=0.0D0
21706 ! gradcorr3_nucl(j,i)=0.0D0
21707 ! gradxorr3_nucl(j,i)=0.0D0
21710 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
21711 !C Calculate the local-electrostatic correlation terms
21712 do i=iatsc_s_nucl,iatsc_e_nucl
21714 num_conti=num_cont_hb(i)
21715 num_conti1=num_cont_hb(i+1)
21716 ! print *,i,num_conti,num_conti1
21721 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
21722 !c & ' jj=',jj,' kk=',kk
21723 if (j1.eq.j+1 .or. j1.eq.j-1) then
21725 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
21726 !C The system gains extra energy.
21727 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
21728 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21729 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
21731 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21732 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
21733 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21735 else if (j1.eq.j) then
21737 !C Contacts I-J and I-(J+1) occur simultaneously.
21738 !C The system loses extra energy.
21739 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
21740 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21741 !C Need to implement full formulas 32 from Liwo et al., 1998.
21743 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21744 !c & ' jj=',jj,' kk=',kk
21745 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
21750 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21751 !c & ' jj=',jj,' kk=',kk
21752 if (j1.eq.j+1) then
21753 !C Contacts I-J and (I+1)-J occur simultaneously.
21754 !C The system loses extra energy.
21755 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
21761 end subroutine multibody_hb_nucl
21762 !-----------------------------------------------------------
21763 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21764 ! implicit real*8 (a-h,o-z)
21765 ! include 'DIMENSIONS'
21766 ! include 'COMMON.IOUNITS'
21767 ! include 'COMMON.DERIV'
21768 ! include 'COMMON.INTERACT'
21769 ! include 'COMMON.CONTACTS'
21770 real(kind=8),dimension(3) :: gx,gx1
21772 !el local variables
21773 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21774 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21775 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21776 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21780 eij=facont_hb(jj,i)
21781 ekl=facont_hb(kk,k)
21782 ees0pij=ees0p(jj,i)
21783 ees0pkl=ees0p(kk,k)
21784 ees0mij=ees0m(jj,i)
21785 ees0mkl=ees0m(kk,k)
21787 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21788 ! print *,"ehbcorr_nucl",ekont,ees
21789 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21790 !C Following 4 lines for diagnostics.
21795 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21796 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21797 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21798 !C Calculate the multi-body contribution to energy.
21799 ! ecorr_nucl=ecorr_nucl+ekont*ees
21800 !C Calculate multi-body contributions to the gradient.
21801 coeffpees0pij=coeffp*ees0pij
21802 coeffmees0mij=coeffm*ees0mij
21803 coeffpees0pkl=coeffp*ees0pkl
21804 coeffmees0mkl=coeffm*ees0mkl
21806 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
21807 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21808 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21809 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
21810 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
21811 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21812 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
21813 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
21814 coeffmees0mij*gacontm_hb1(ll,kk,k))
21815 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
21816 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21817 coeffmees0mij*gacontm_hb2(ll,kk,k))
21818 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21819 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21820 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21821 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
21822 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
21823 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21824 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21825 coeffmees0mij*gacontm_hb3(ll,kk,k))
21826 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
21827 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
21828 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
21829 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
21830 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
21831 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
21833 ehbcorr_nucl=ekont*ees
21835 end function ehbcorr_nucl
21836 !-------------------------------------------------------------------------
21838 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21839 ! implicit real*8 (a-h,o-z)
21840 ! include 'DIMENSIONS'
21841 ! include 'COMMON.IOUNITS'
21842 ! include 'COMMON.DERIV'
21843 ! include 'COMMON.INTERACT'
21844 ! include 'COMMON.CONTACTS'
21845 real(kind=8),dimension(3) :: gx,gx1
21847 !el local variables
21848 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21849 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21850 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21851 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21855 eij=facont_hb(jj,i)
21856 ekl=facont_hb(kk,k)
21857 ees0pij=ees0p(jj,i)
21858 ees0pkl=ees0p(kk,k)
21859 ees0mij=ees0m(jj,i)
21860 ees0mkl=ees0m(kk,k)
21862 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21863 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21864 !C Following 4 lines for diagnostics.
21869 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21870 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21871 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21872 !C Calculate the multi-body contribution to energy.
21873 ! ecorr=ecorr+ekont*ees
21874 !C Calculate multi-body contributions to the gradient.
21875 coeffpees0pij=coeffp*ees0pij
21876 coeffmees0mij=coeffm*ees0mij
21877 coeffpees0pkl=coeffp*ees0pkl
21878 coeffmees0mkl=coeffm*ees0mkl
21880 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
21881 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21882 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21883 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
21884 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
21885 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21886 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
21887 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
21888 coeffmees0mij*gacontm_hb1(ll,kk,k))
21889 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
21890 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21891 coeffmees0mij*gacontm_hb2(ll,kk,k))
21892 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21893 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21894 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21895 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
21896 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
21897 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21898 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21899 coeffmees0mij*gacontm_hb3(ll,kk,k))
21900 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
21901 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
21902 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
21903 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
21904 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
21905 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
21907 ehbcorr3_nucl=ekont*ees
21909 end function ehbcorr3_nucl
21911 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
21912 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21913 real(kind=8):: buffer(dimen1,dimen2)
21914 num_kont=num_cont_hb(atom)
21918 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
21921 buffer(i,indx+25)=facont_hb(i,atom)
21922 buffer(i,indx+26)=ees0p(i,atom)
21923 buffer(i,indx+27)=ees0m(i,atom)
21924 buffer(i,indx+28)=d_cont(i,atom)
21925 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
21927 buffer(1,indx+30)=dfloat(num_kont)
21929 end subroutine pack_buffer
21930 !c------------------------------------------------------------------------------
21931 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
21932 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21933 real(kind=8):: buffer(dimen1,dimen2)
21934 ! double precision zapas
21935 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
21936 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
21937 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
21938 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
21939 num_kont=buffer(1,indx+30)
21940 num_kont_old=num_cont_hb(atom)
21941 num_cont_hb(atom)=num_kont+num_kont_old
21946 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
21949 facont_hb(ii,atom)=buffer(i,indx+25)
21950 ees0p(ii,atom)=buffer(i,indx+26)
21951 ees0m(ii,atom)=buffer(i,indx+27)
21952 d_cont(i,atom)=buffer(i,indx+28)
21953 jcont_hb(ii,atom)=buffer(i,indx+29)
21956 end subroutine unpack_buffer
21957 !c------------------------------------------------------------------------------
21959 subroutine ecatcat(ecationcation)
21960 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k
21961 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21962 r7,r4,ecationcation,k0,rcal
21963 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21964 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
21965 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21968 ecationcation=0.0d0
21969 if (nres_molec(5).eq.0) return
21974 k0 = 332.0*(2.0*2.0)/80.0
21978 itmp=itmp+nres_molec(i)
21980 ! write(iout,*) "itmp",itmp
21981 do i=itmp+1,itmp+nres_molec(5)-1
21987 xi=mod(xi,boxxsize)
21988 if (xi.lt.0) xi=xi+boxxsize
21989 yi=mod(yi,boxysize)
21990 if (yi.lt.0) yi=yi+boxysize
21991 zi=mod(zi,boxzsize)
21992 if (zi.lt.0) zi=zi+boxzsize
21994 do j=i+1,itmp+nres_molec(5)
21995 ! print *,i,j,'catcat'
21999 xj=dmod(xj,boxxsize)
22000 if (xj.lt.0) xj=xj+boxxsize
22001 yj=dmod(yj,boxysize)
22002 if (yj.lt.0) yj=yj+boxysize
22003 zj=dmod(zj,boxzsize)
22004 if (zj.lt.0) zj=zj+boxzsize
22005 ! write(iout,*) c(1,i),xi,xj,"xy",boxxsize
22006 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22014 xj=xj_safe+xshift*boxxsize
22015 yj=yj_safe+yshift*boxysize
22016 zj=zj_safe+zshift*boxzsize
22017 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22018 if(dist_temp.lt.dist_init) then
22019 dist_init=dist_temp
22028 if (subchap.eq.1) then
22037 rcal =xj**2+yj**2+zj**2
22043 ! k0 = 332*(2*2)/80
22044 Evan1cat=epscalc*(r012/rcal**6)
22045 Evan2cat=epscalc*2*(r06/rcal**3)
22053 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
22054 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
22055 dEeleccat(k)=-k0*r(k)/ract**3
22058 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
22059 gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
22060 gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
22063 ! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
22064 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
22068 end subroutine ecatcat
22069 !---------------------------------------------------------------------------
22070 subroutine ecat_prot(ecation_prot)
22071 integer i,j,k,subchap,itmp,inum
22072 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
22073 r7,r4,ecationcation
22074 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
22075 dist_init,dist_temp,ecation_prot,rcal,rocal, &
22076 Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
22077 catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
22078 wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
22079 costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
22080 Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
22081 rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
22082 opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
22083 opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
22084 Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip
22085 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
22086 gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
22087 dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
22088 tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
22089 v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
22090 dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
22091 dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
22092 dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
22094 real(kind=8),dimension(6) :: vcatprm
22096 ! first lets calculate interaction with peptide groups
22097 if (nres_molec(5).eq.0) return
22099 wdip =1.092777950857032D2
22101 wmodquad=-2.174122713004870D4
22102 wmodquad=wmodquad/wconst
22103 wquad1 = 3.901232068562804D1
22104 wquad1=wquad1/wconst
22106 wquad2=wquad2/wconst
22111 itmp=itmp+nres_molec(i)
22113 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
22114 do i=ibond_start,ibond_end
22116 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
22117 xi=0.5d0*(c(1,i)+c(1,i+1))
22118 yi=0.5d0*(c(2,i)+c(2,i+1))
22119 zi=0.5d0*(c(3,i)+c(3,i+1))
22120 xi=mod(xi,boxxsize)
22121 if (xi.lt.0) xi=xi+boxxsize
22122 yi=mod(yi,boxysize)
22123 if (yi.lt.0) yi=yi+boxysize
22124 zi=mod(zi,boxzsize)
22125 if (zi.lt.0) zi=zi+boxzsize
22127 do j=itmp+1,itmp+nres_molec(5)
22131 xj=dmod(xj,boxxsize)
22132 if (xj.lt.0) xj=xj+boxxsize
22133 yj=dmod(yj,boxysize)
22134 if (yj.lt.0) yj=yj+boxysize
22135 zj=dmod(zj,boxzsize)
22136 if (zj.lt.0) zj=zj+boxzsize
22137 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22145 xj=xj_safe+xshift*boxxsize
22146 yj=yj_safe+yshift*boxysize
22147 zj=zj_safe+zshift*boxzsize
22148 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22149 if(dist_temp.lt.dist_init) then
22150 dist_init=dist_temp
22159 if (subchap.eq.1) then
22170 rcpm = sqrt(xj**2+yj**2+zj**2)
22171 drcp_norm(1)=xj/rcpm
22172 drcp_norm(2)=yj/rcpm
22173 drcp_norm(3)=zj/rcpm
22176 dcmag=dcmag+dc(k,i)**2
22180 myd_norm(k)=dc(k,i)/dcmag
22182 costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
22183 drcp_norm(3)*myd_norm(3)
22186 Irsecp = 1.0d0/rsecp
22187 Irthrp = Irsecp/rcpm
22188 Irfourp = Irthrp/rcpm
22189 Irfiftp = Irfourp/rcpm
22190 Irsistp=Irfiftp/rcpm
22191 Irseven=Irsistp/rcpm
22192 Irtwelv=Irsistp*Irsistp
22193 Irthir=Irtwelv/rcpm
22194 sin2thet = (1-costhet*costhet)
22195 sinthet=sqrt(sin2thet)
22196 E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
22198 E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
22199 2*wvan2**6*Irsistp)
22200 ecation_prot = ecation_prot+E1+E2
22201 dE1dr = -2*costhet*wdip*Irthrp-&
22202 (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
22203 dE2dr = 3*wquad1*wquad2*Irfourp- &
22204 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
22205 dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
22207 drdpep(k) = -drcp_norm(k)
22208 dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
22209 dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
22210 dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
22211 dEddci(k) = dEdcos*dcosddci(k)
22214 gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
22215 gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
22216 gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
22220 !------------------------------------------sidechains
22221 ! do i=1,nres_molec(1)
22222 do i=ibond_start,ibond_end
22223 if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
22225 ! print *,i,ecation_prot
22229 xi=mod(xi,boxxsize)
22230 if (xi.lt.0) xi=xi+boxxsize
22231 yi=mod(yi,boxysize)
22232 if (yi.lt.0) yi=yi+boxysize
22233 zi=mod(zi,boxzsize)
22234 if (zi.lt.0) zi=zi+boxzsize
22236 cm1(k)=dc(k,i+nres)
22238 cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
22239 do j=itmp+1,itmp+nres_molec(5)
22243 xj=dmod(xj,boxxsize)
22244 if (xj.lt.0) xj=xj+boxxsize
22245 yj=dmod(yj,boxysize)
22246 if (yj.lt.0) yj=yj+boxysize
22247 zj=dmod(zj,boxzsize)
22248 if (zj.lt.0) zj=zj+boxzsize
22249 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22257 xj=xj_safe+xshift*boxxsize
22258 yj=yj_safe+yshift*boxysize
22259 zj=zj_safe+zshift*boxzsize
22260 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22261 if(dist_temp.lt.dist_init) then
22262 dist_init=dist_temp
22271 if (subchap.eq.1) then
22282 if(itype(i,1).eq.15.or.itype(i,1).eq.16) then
22283 if(itype(i,1).eq.16) then
22289 vcatprm(k)=catprm(k,inum)
22291 dASGL=catprm(7,inum)
22293 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22298 dx(k) = vcat(k)-vcm(k)
22301 v1(k)=(vcm(k)-valpha(k))
22302 v2(k)=(vcat(k)-valpha(k))
22304 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22305 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22306 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22308 ! The weights of the energy function calculated from
22309 !The quantum mechanical GAMESS simulations of calcium with ASP/GLU
22317 wquad2 = vcatprm(4)
22322 opt = dx(1)**2+dx(2)**2
22323 rsecp = opt+dx(3)**2
22327 rsixp = rfourp*rsecp
22332 Irfourp = Irthrp/rs
22338 opt1 = (4*rs*dx(3)*wdip)
22339 opt2 = 6*rsecp*wquad1*opt
22340 opt3 = wquad1*wquad2p*Irsixp
22341 opt4 = (wvan1*wvan2**12)
22342 opt5 = opt4*12*Irfourt
22343 opt6 = 2*wvan1*wvan2**6
22344 opt7 = 6*opt6*Ireight
22347 opt11 = (rsecp*v2m)**2
22348 opt12 = (rsecp*v1m)**2
22349 opt14 = (v1m*v2m*rsecp)**2
22350 opt15 = -wquad1/v2m**2
22351 opt16 = (rthrp*(v1m*v2m)**2)**2
22352 opt17 = (v1m**2*rthrp)**2
22353 opt18 = -wquad1/rthrp
22354 opt19 = (v1m**2*v2m**2)**2
22357 dEcCat(k) = -(dx(k)*wc)*Irthrp
22358 dEcCm(k)=(dx(k)*wc)*Irthrp
22361 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22363 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
22364 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22365 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
22366 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22367 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
22368 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
22371 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22373 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
22374 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
22375 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22376 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
22377 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
22378 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22379 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22380 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
22383 Equad2=wquad1*wquad2p*Irthrp
22385 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22386 dEquad2Cm(k)=3*dx(k)*rs*opt3
22387 dEquad2Calp(k)=0.0d0
22391 dEvan1Cat(k)=-dx(k)*opt5
22392 dEvan1Cm(k)=dx(k)*opt5
22393 dEvan1Calp(k)=0.0d0
22397 dEvan2Cat(k)=dx(k)*opt7
22398 dEvan2Cm(k)=-dx(k)*opt7
22399 dEvan2Calp(k)=0.0d0
22401 ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
22402 ! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
22405 dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
22406 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22407 !c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
22408 dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
22409 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22410 dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
22411 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22415 dscvec(k) = dc(k,i+nres)
22416 dscmag = dscmag+dscvec(k)*dscvec(k)
22419 dscmag = sqrt(dscmag)
22420 dscmag3 = dscmag3*dscmag
22421 constA = 1.0d0+dASGL/dscmag
22424 constB = constB+dscvec(k)*dEtotalCm(k)
22426 constB = constB*dASGL/dscmag3
22428 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22429 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22430 constA*dEtotalCm(k)-constB*dscvec(k)
22431 ! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
22432 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22433 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22435 else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
22436 if(itype(i,1).eq.14) then
22442 vcatprm(k)=catprm(k,inum)
22444 dASGL=catprm(7,inum)
22446 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22452 dx(k) = vcat(k)-vcm(k)
22455 v1(k)=(vcm(k)-valpha(k))
22456 v2(k)=(vcat(k)-valpha(k))
22458 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22459 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22460 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22461 ! The weights of the energy function calculated from
22462 !The quantum mechanical GAMESS simulations of ASN/GLN with calcium
22468 wquad2 = vcatprm(4)
22473 opt = dx(1)**2+dx(2)**2
22474 rsecp = opt+dx(3)**2
22478 rsixp = rfourp*rsecp
22483 Irfourp = Irthrp/rs
22489 opt1 = (4*rs*dx(3)*wdip)
22490 opt2 = 6*rsecp*wquad1*opt
22491 opt3 = wquad1*wquad2p*Irsixp
22492 opt4 = (wvan1*wvan2**12)
22493 opt5 = opt4*12*Irfourt
22494 opt6 = 2*wvan1*wvan2**6
22495 opt7 = 6*opt6*Ireight
22498 opt11 = (rsecp*v2m)**2
22499 opt12 = (rsecp*v1m)**2
22500 opt14 = (v1m*v2m*rsecp)**2
22501 opt15 = -wquad1/v2m**2
22502 opt16 = (rthrp*(v1m*v2m)**2)**2
22503 opt17 = (v1m**2*rthrp)**2
22504 opt18 = -wquad1/rthrp
22505 opt19 = (v1m**2*v2m**2)**2
22506 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22508 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
22509 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22510 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
22511 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22512 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
22513 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
22516 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22518 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
22519 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
22520 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22521 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
22522 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
22523 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22524 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22525 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
22528 Equad2=wquad1*wquad2p*Irthrp
22530 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22531 dEquad2Cm(k)=3*dx(k)*rs*opt3
22532 dEquad2Calp(k)=0.0d0
22536 dEvan1Cat(k)=-dx(k)*opt5
22537 dEvan1Cm(k)=dx(k)*opt5
22538 dEvan1Calp(k)=0.0d0
22542 dEvan2Cat(k)=dx(k)*opt7
22543 dEvan2Cm(k)=-dx(k)*opt7
22544 dEvan2Calp(k)=0.0d0
22546 ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
22548 dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
22549 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22550 dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
22551 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22552 dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
22553 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22557 dscvec(k) = c(k,i+nres)-c(k,i)
22558 dscmag = dscmag+dscvec(k)*dscvec(k)
22561 dscmag = sqrt(dscmag)
22562 dscmag3 = dscmag3*dscmag
22563 constA = 1+dASGL/dscmag
22566 constB = constB+dscvec(k)*dEtotalCm(k)
22568 constB = constB*dASGL/dscmag3
22570 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22571 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22572 constA*dEtotalCm(k)-constB*dscvec(k)
22573 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22574 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22579 r(k) = c(k,j)-c(k,i+nres)
22580 rcal = rcal+r(k)*r(k)
22585 r0p=0.5*(rocal+sig0(itype(i,1)))
22588 Evan1=epscalc*(r012/rcal**6)
22589 Evan2=epscalc*2*(r06/rcal**3)
22593 dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
22594 dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
22597 dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
22599 ecation_prot = ecation_prot+ Evan1+Evan2
22601 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22603 gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
22604 gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
22606 endif ! 13-16 residues
22610 end subroutine ecat_prot
22612 !----------------------------------------------------------------------------
22613 !-----------------------------------------------------------------------------
22614 !-----------------------------------------------------------------------------
22615 subroutine eprot_sc_base(escbase)
22617 ! implicit real*8 (a-h,o-z)
22618 ! include 'DIMENSIONS'
22619 ! include 'COMMON.GEO'
22620 ! include 'COMMON.VAR'
22621 ! include 'COMMON.LOCAL'
22622 ! include 'COMMON.CHAIN'
22623 ! include 'COMMON.DERIV'
22624 ! include 'COMMON.NAMES'
22625 ! include 'COMMON.INTERACT'
22626 ! include 'COMMON.IOUNITS'
22627 ! include 'COMMON.CALC'
22628 ! include 'COMMON.CONTROL'
22629 ! include 'COMMON.SBRIDGE'
22631 !el local variables
22632 integer :: iint,itypi,itypi1,itypj,subchap
22633 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22634 real(kind=8) :: evdw,sig0ij
22635 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22636 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22637 sslipi,sslipj,faclip
22639 real(kind=8) :: fracinbuf
22640 real (kind=8) :: escbase
22641 real (kind=8),dimension(4):: ener
22642 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22643 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22644 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
22645 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22646 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
22647 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22648 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22649 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22650 real(kind=8),dimension(3,2)::chead,erhead_tail
22651 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22655 ! do i=1,nres_molec(1)
22656 do i=ibond_start,ibond_end
22657 if (itype(i,1).eq.ntyp1_molec(1)) cycle
22659 dxi = dc_norm(1,nres+i)
22660 dyi = dc_norm(2,nres+i)
22661 dzi = dc_norm(3,nres+i)
22662 dsci_inv = vbld_inv(i+nres)
22666 xi=mod(xi,boxxsize)
22667 if (xi.lt.0) xi=xi+boxxsize
22668 yi=mod(yi,boxysize)
22669 if (yi.lt.0) yi=yi+boxysize
22670 zi=mod(zi,boxzsize)
22671 if (zi.lt.0) zi=zi+boxzsize
22672 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
22674 if (itype(j,2).eq.ntyp1_molec(2))cycle
22678 xj=dmod(xj,boxxsize)
22679 if (xj.lt.0) xj=xj+boxxsize
22680 yj=dmod(yj,boxysize)
22681 if (yj.lt.0) yj=yj+boxysize
22682 zj=dmod(zj,boxzsize)
22683 if (zj.lt.0) zj=zj+boxzsize
22684 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22693 xj=xj_safe+xshift*boxxsize
22694 yj=yj_safe+yshift*boxysize
22695 zj=zj_safe+zshift*boxzsize
22696 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22697 if(dist_temp.lt.dist_init) then
22698 dist_init=dist_temp
22707 if (subchap.eq.1) then
22716 dxj = dc_norm( 1, nres+j )
22717 dyj = dc_norm( 2, nres+j )
22718 dzj = dc_norm( 3, nres+j )
22719 ! print *,i,j,itypi,itypj
22720 d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
22721 d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
22724 ! BetaT = 1.0d0 / (298.0d0 * Rb)
22726 sig0ij = sigma_scbase( itypi,itypj )
22727 chi1 = chi_scbase( itypi, itypj,1 )
22728 chi2 = chi_scbase( itypi, itypj,2 )
22731 chi12 = chi1 * chi2
22732 chip1 = chipp_scbase( itypi, itypj,1 )
22733 chip2 = chipp_scbase( itypi, itypj,2 )
22736 chip12 = chip1 * chip2
22737 ! not used by momo potential, but needed by sc_angular which is shared
22738 ! by all energy_potential subroutines
22742 a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
22743 ! a12sq = a12sq * a12sq
22744 ! charge of amino acid itypi is...
22745 chis1 = chis_scbase(itypi,itypj,1)
22746 chis2 = chis_scbase(itypi,itypj,2)
22747 chis12 = chis1 * chis2
22748 sig1 = sigmap1_scbase(itypi,itypj)
22749 sig2 = sigmap2_scbase(itypi,itypj)
22750 ! write (*,*) "sig1 = ", sig1
22751 ! write (*,*) "sig2 = ", sig2
22752 ! alpha factors from Fcav/Gcav
22753 b1 = alphasur_scbase(1,itypi,itypj)
22755 b2 = alphasur_scbase(2,itypi,itypj)
22756 b3 = alphasur_scbase(3,itypi,itypj)
22757 b4 = alphasur_scbase(4,itypi,itypj)
22758 ! used to determine whether we want to do quadrupole calculations
22760 eps_in = epsintab_scbase(itypi,itypj)
22761 if (eps_in.eq.0.0) eps_in=1.0
22762 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
22763 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
22764 !-------------------------------------------------------------------
22765 ! tail location and distance calculations
22767 ! location of polar head is computed by taking hydrophobic centre
22768 ! and moving by a d1 * dc_norm vector
22769 ! see unres publications for very informative images
22770 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
22771 chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
22773 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22774 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22775 Rhead_distance(k) = chead(k,2) - chead(k,1)
22777 ! pitagoras (root of sum of squares)
22779 (Rhead_distance(1)*Rhead_distance(1)) &
22780 + (Rhead_distance(2)*Rhead_distance(2)) &
22781 + (Rhead_distance(3)*Rhead_distance(3)))
22782 !-------------------------------------------------------------------
22783 ! zero everything that should be zero'ed
22801 dscj_inv = vbld_inv(j+nres)
22802 ! print *,i,j,dscj_inv,dsci_inv
22803 ! rij holds 1/(distance of Calpha atoms)
22804 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
22806 !----------------------------
22808 ! this should be in elgrad_init but om's are calculated by sc_angular
22809 ! which in turn is used by older potentials
22810 ! om = omega, sqom = om^2
22813 sqom12 = om12 * om12
22815 ! now we calculate EGB - Gey-Berne
22816 ! It will be summed up in evdwij and saved in evdw
22817 sigsq = 1.0D0 / sigsq
22818 sig = sig0ij * dsqrt(sigsq)
22819 ! rij_shift = 1.0D0 / rij - sig + sig0ij
22820 rij_shift = 1.0/rij - sig + sig0ij
22821 IF (rij_shift.le.0.0D0) THEN
22825 sigder = -sig * sigsq
22826 rij_shift = 1.0D0 / rij_shift
22827 fac = rij_shift**expon
22828 c1 = fac * fac * aa_scbase(itypi,itypj)
22830 c2 = fac * bb_scbase(itypi,itypj)
22832 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
22833 eps2der = eps3rt * evdwij
22834 eps3der = eps2rt * evdwij
22835 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
22836 evdwij = eps2rt * eps3rt * evdwij
22837 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
22838 fac = -expon * (c1 + evdwij) * rij_shift
22839 sigder = fac * sigder
22841 ! Calculate distance derivative
22845 ! if (b2.gt.0.0) then
22846 fac = chis1 * sqom1 + chis2 * sqom2 &
22847 - 2.0d0 * chis12 * om1 * om2 * om12
22848 ! we will use pom later in Gcav, so dont mess with it!
22849 pom = 1.0d0 - chis1 * chis2 * sqom12
22850 Lambf = (1.0d0 - (fac / pom))
22851 Lambf = dsqrt(Lambf)
22852 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
22853 ! write (*,*) "sparrow = ", sparrow
22854 Chif = 1.0d0/rij * sparrow
22855 ChiLambf = Chif * Lambf
22856 eagle = dsqrt(ChiLambf)
22857 bat = ChiLambf ** 11.0d0
22858 top = b1 * ( eagle + b2 * ChiLambf - b3 )
22859 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
22863 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
22864 dbot = 12.0d0 * b4 * bat * Lambf
22865 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
22867 ! write (*,*) "dFcav/dR = ", dFdR
22868 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
22869 dbot = 12.0d0 * b4 * bat * Chif
22870 eagle = Lambf * pom
22871 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
22872 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
22873 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
22874 * (chis2 * om2 * om12 - om1) / (eagle * pom)
22876 dFdL = ((dtop * bot - top * dbot) / botsq)
22878 dCAVdOM1 = dFdL * ( dFdOM1 )
22879 dCAVdOM2 = dFdL * ( dFdOM2 )
22880 dCAVdOM12 = dFdL * ( dFdOM12 )
22885 ! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
22886 ! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
22887 ! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
22888 ! -2.0D0*alf12*eps3der+sigder*sigsq_om12
22889 ! print *,"EOMY",eom1,eom2,eom12
22890 ! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
22891 ! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
22893 ! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
22894 ! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22896 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22897 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22899 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
22900 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22901 - (( dFdR + gg(k) ) * pom)
22902 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22903 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22904 ! & - ( dFdR * pom )
22906 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
22907 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22908 + (( dFdR + gg(k) ) * pom)
22909 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22910 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22911 !c! & + ( dFdR * pom )
22913 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22914 - (( dFdR + gg(k) ) * ertail(k))
22915 !c! & - ( dFdR * ertail(k))
22917 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22918 + (( dFdR + gg(k) ) * ertail(k))
22919 !c! & + ( dFdR * ertail(k))
22922 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22923 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22930 if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
22931 w1 = wdipdip_scbase(1,itypi,itypj)
22932 w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
22933 w3 = wdipdip_scbase(2,itypi,itypj)
22934 !c!-------------------------------------------------------------------
22936 fac = (om12 - 3.0d0 * om1 * om2)
22937 c1 = (w1 / (Rhead**3.0d0)) * fac
22938 c2 = (w2 / Rhead ** 6.0d0) &
22939 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22940 c3= (w3/ Rhead ** 6.0d0) &
22941 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
22943 !c! write (*,*) "w1 = ", w1
22944 !c! write (*,*) "w2 = ", w2
22945 !c! write (*,*) "om1 = ", om1
22946 !c! write (*,*) "om2 = ", om2
22947 !c! write (*,*) "om12 = ", om12
22948 !c! write (*,*) "fac = ", fac
22949 !c! write (*,*) "c1 = ", c1
22950 !c! write (*,*) "c2 = ", c2
22951 !c! write (*,*) "Ecl = ", Ecl
22952 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
22953 !c! write (*,*) "c2_2 = ",
22954 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22955 !c!-------------------------------------------------------------------
22956 !c! dervative of ECL is GCL...
22958 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
22959 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
22960 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
22961 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
22962 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
22963 dGCLdR = c1 - c2 + c3
22965 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
22966 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22967 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
22968 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
22969 dGCLdOM1 = c1 - c2 + c3
22971 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
22972 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22973 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
22974 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
22975 dGCLdOM2 = c1 - c2 + c3
22977 c1 = w1 / (Rhead ** 3.0d0)
22978 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
22979 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
22980 dGCLdOM12 = c1 - c2 + c3
22982 erhead(k) = Rhead_distance(k)/Rhead
22984 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22985 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22986 facd1 = d1i * vbld_inv(i+nres)
22987 facd2 = d1j * vbld_inv(j+nres)
22990 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22991 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22993 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22994 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22997 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22998 - dGCLdR * erhead(k)
22999 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
23000 + dGCLdR * erhead(k)
23003 !now charge with dipole eg. ARG-dG
23004 if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
23005 alphapol1 = alphapol_scbase(itypi,itypj)
23006 w1 = wqdip_scbase(1,itypi,itypj)
23007 w2 = wqdip_scbase(2,itypi,itypj)
23010 ! pis = sig0head_scbase(itypi,itypj)
23011 ! eps_head = epshead_scbase(itypi,itypj)
23012 !c!-------------------------------------------------------------------
23013 !c! R1 - distance between head of ith side chain and tail of jth sidechain
23016 !c! Calculate head-to-tail distances tail is center of side-chain
23017 R1=R1+(c(k,j+nres)-chead(k,1))**2
23022 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
23023 !c! & +dhead(1,1,itypi,itypj))**2))
23024 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
23025 !c! & +dhead(2,1,itypi,itypj))**2))
23027 !c!-------------------------------------------------------------------
23030 hawk = w2 * (1.0d0 - sqom2)
23031 Ecl = sparrow / Rhead**2.0d0 &
23032 - hawk / Rhead**4.0d0
23033 !c!-------------------------------------------------------------------
23034 !c! derivative of ecl is Gcl
23036 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
23037 + 4.0d0 * hawk / Rhead**5.0d0
23039 dGCLdOM1 = (w1) / (Rhead**2.0d0)
23041 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
23042 !c--------------------------------------------------------------------
23043 !c Polarization energy
23045 MomoFac1 = (1.0d0 - chi1 * sqom2)
23046 RR1 = R1 * R1 / MomoFac1
23047 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
23048 fgb1 = sqrt( RR1 + a12sq * ee1)
23049 ! eps_inout_fac=0.0d0
23050 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
23051 ! derivative of Epol is Gpol...
23052 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
23054 dFGBdR1 = ( (R1 / MomoFac1) &
23055 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
23057 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
23058 * (2.0d0 - 0.5d0 * ee1) ) &
23060 dPOLdR1 = dPOLdFGB1 * dFGBdR1
23063 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
23065 erhead(k) = Rhead_distance(k)/Rhead
23066 erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
23069 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23070 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
23071 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
23073 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
23074 facd1 = d1i * vbld_inv(i+nres)
23075 facd2 = d1j * vbld_inv(j+nres)
23076 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
23079 hawk = (erhead_tail(k,1) + &
23080 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
23083 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23084 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
23086 - dPOLdR1 * (erhead_tail(k,1))
23089 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
23090 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
23092 + dPOLdR1 * (erhead_tail(k,1))
23096 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
23097 - dGCLdR * erhead(k) &
23098 - dPOLdR1 * erhead_tail(k,1)
23099 ! & - dGLJdR * erhead(k)
23101 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
23102 + dGCLdR * erhead(k) &
23103 + dPOLdR1 * erhead_tail(k,1)
23104 ! & + dGLJdR * erhead(k)
23108 ! print *,i,j,evdwij,epol,Fcav,ECL
23109 escbase=escbase+evdwij+epol+Fcav+ECL
23110 call sc_grad_scbase
23115 end subroutine eprot_sc_base
23116 SUBROUTINE sc_grad_scbase
23119 real (kind=8) :: dcosom1(3),dcosom2(3)
23121 eps2der * eps2rt_om1 &
23122 - 2.0D0 * alf1 * eps3der &
23123 + sigder * sigsq_om1 &
23129 eps2der * eps2rt_om2 &
23130 + 2.0D0 * alf2 * eps3der &
23131 + sigder * sigsq_om2 &
23137 evdwij * eps1_om12 &
23138 + eps2der * eps2rt_om12 &
23139 - 2.0D0 * alf12 * eps3der &
23140 + sigder *sigsq_om12 &
23144 ! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23145 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23146 ! gg(1),gg(2),"rozne"
23148 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
23149 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
23150 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23151 gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
23152 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23153 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23154 gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
23155 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23156 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23157 gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
23158 gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
23161 END SUBROUTINE sc_grad_scbase
23164 subroutine epep_sc_base(epepbase)
23167 !el local variables
23168 integer :: iint,itypi,itypi1,itypj,subchap
23169 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23170 real(kind=8) :: evdw,sig0ij
23171 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23172 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23173 sslipi,sslipj,faclip
23175 real(kind=8) :: fracinbuf
23176 real (kind=8) :: epepbase
23177 real (kind=8),dimension(4):: ener
23178 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23179 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23180 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
23181 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23182 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
23183 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23184 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23185 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
23186 real(kind=8),dimension(3,2)::chead,erhead_tail
23187 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23191 ! do i=1,nres_molec(1)-1
23192 do i=ibond_start,ibond_end
23193 if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
23194 !C itypi = itype(i,1)
23198 ! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
23199 dsci_inv = vbld_inv(i+1)/2.0
23200 xi=(c(1,i)+c(1,i+1))/2.0
23201 yi=(c(2,i)+c(2,i+1))/2.0
23202 zi=(c(3,i)+c(3,i+1))/2.0
23203 xi=mod(xi,boxxsize)
23204 if (xi.lt.0) xi=xi+boxxsize
23205 yi=mod(yi,boxysize)
23206 if (yi.lt.0) yi=yi+boxysize
23207 zi=mod(zi,boxzsize)
23208 if (zi.lt.0) zi=zi+boxzsize
23209 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
23211 if (itype(j,2).eq.ntyp1_molec(2))cycle
23215 xj=dmod(xj,boxxsize)
23216 if (xj.lt.0) xj=xj+boxxsize
23217 yj=dmod(yj,boxysize)
23218 if (yj.lt.0) yj=yj+boxysize
23219 zj=dmod(zj,boxzsize)
23220 if (zj.lt.0) zj=zj+boxzsize
23221 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23230 xj=xj_safe+xshift*boxxsize
23231 yj=yj_safe+yshift*boxysize
23232 zj=zj_safe+zshift*boxzsize
23233 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23234 if(dist_temp.lt.dist_init) then
23235 dist_init=dist_temp
23244 if (subchap.eq.1) then
23253 dxj = dc_norm( 1, nres+j )
23254 dyj = dc_norm( 2, nres+j )
23255 dzj = dc_norm( 3, nres+j )
23256 ! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
23257 ! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
23260 sig0ij = sigma_pepbase(itypj )
23261 chi1 = chi_pepbase(itypj,1 )
23262 chi2 = chi_pepbase(itypj,2 )
23265 chi12 = chi1 * chi2
23266 chip1 = chipp_pepbase(itypj,1 )
23267 chip2 = chipp_pepbase(itypj,2 )
23270 chip12 = chip1 * chip2
23271 chis1 = chis_pepbase(itypj,1)
23272 chis2 = chis_pepbase(itypj,2)
23273 chis12 = chis1 * chis2
23274 sig1 = sigmap1_pepbase(itypj)
23275 sig2 = sigmap2_pepbase(itypj)
23276 ! write (*,*) "sig1 = ", sig1
23277 ! write (*,*) "sig2 = ", sig2
23279 ! location of polar head is computed by taking hydrophobic centre
23280 ! and moving by a d1 * dc_norm vector
23281 ! see unres publications for very informative images
23282 chead(k,1) = (c(k,i)+c(k,i+1))/2.0
23283 ! + d1i * dc_norm(k, i+nres)
23284 chead(k,2) = c(k, j+nres)
23285 ! + d1j * dc_norm(k, j+nres)
23287 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23288 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23289 Rhead_distance(k) = chead(k,2) - chead(k,1)
23290 ! print *,gvdwc_pepbase(k,i)
23294 (Rhead_distance(1)*Rhead_distance(1)) &
23295 + (Rhead_distance(2)*Rhead_distance(2)) &
23296 + (Rhead_distance(3)*Rhead_distance(3)))
23298 ! alpha factors from Fcav/Gcav
23299 b1 = alphasur_pepbase(1,itypj)
23301 b2 = alphasur_pepbase(2,itypj)
23302 b3 = alphasur_pepbase(3,itypj)
23303 b4 = alphasur_pepbase(4,itypj)
23307 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23310 !----------------------------
23328 dscj_inv = vbld_inv(j+nres)
23330 ! this should be in elgrad_init but om's are calculated by sc_angular
23331 ! which in turn is used by older potentials
23332 ! om = omega, sqom = om^2
23335 sqom12 = om12 * om12
23337 ! now we calculate EGB - Gey-Berne
23338 ! It will be summed up in evdwij and saved in evdw
23339 sigsq = 1.0D0 / sigsq
23340 sig = sig0ij * dsqrt(sigsq)
23341 rij_shift = 1.0/rij - sig + sig0ij
23342 IF (rij_shift.le.0.0D0) THEN
23346 sigder = -sig * sigsq
23347 rij_shift = 1.0D0 / rij_shift
23348 fac = rij_shift**expon
23349 c1 = fac * fac * aa_pepbase(itypj)
23351 c2 = fac * bb_pepbase(itypj)
23353 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23354 eps2der = eps3rt * evdwij
23355 eps3der = eps2rt * evdwij
23356 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23357 evdwij = eps2rt * eps3rt * evdwij
23358 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23359 fac = -expon * (c1 + evdwij) * rij_shift
23360 sigder = fac * sigder
23362 ! Calculate distance derivative
23366 fac = chis1 * sqom1 + chis2 * sqom2 &
23367 - 2.0d0 * chis12 * om1 * om2 * om12
23368 ! we will use pom later in Gcav, so dont mess with it!
23369 pom = 1.0d0 - chis1 * chis2 * sqom12
23370 Lambf = (1.0d0 - (fac / pom))
23371 Lambf = dsqrt(Lambf)
23372 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23373 ! write (*,*) "sparrow = ", sparrow
23374 Chif = 1.0d0/rij * sparrow
23375 ChiLambf = Chif * Lambf
23376 eagle = dsqrt(ChiLambf)
23377 bat = ChiLambf ** 11.0d0
23378 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23379 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23383 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23384 dbot = 12.0d0 * b4 * bat * Lambf
23385 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23387 ! write (*,*) "dFcav/dR = ", dFdR
23388 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23389 dbot = 12.0d0 * b4 * bat * Chif
23390 eagle = Lambf * pom
23391 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23392 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23393 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23394 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23396 dFdL = ((dtop * bot - top * dbot) / botsq)
23398 dCAVdOM1 = dFdL * ( dFdOM1 )
23399 dCAVdOM2 = dFdL * ( dFdOM2 )
23400 dCAVdOM12 = dFdL * ( dFdOM12 )
23406 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23407 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23409 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23410 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23411 - (( dFdR + gg(k) ) * pom)/2.0
23412 ! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
23413 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23414 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23415 ! & - ( dFdR * pom )
23417 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23418 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23419 + (( dFdR + gg(k) ) * pom)
23420 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23421 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23422 !c! & + ( dFdR * pom )
23424 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23425 - (( dFdR + gg(k) ) * ertail(k))/2.0
23426 ! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
23428 !c! & - ( dFdR * ertail(k))
23430 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23431 + (( dFdR + gg(k) ) * ertail(k))
23432 !c! & + ( dFdR * ertail(k))
23435 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23436 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23440 w1 = wdipdip_pepbase(1,itypj)
23441 w2 = -wdipdip_pepbase(3,itypj)/2.0
23442 w3 = wdipdip_pepbase(2,itypj)
23445 !c!-------------------------------------------------------------------
23448 fac = (om12 - 3.0d0 * om1 * om2)
23449 c1 = (w1 / (Rhead**3.0d0)) * fac
23450 c2 = (w2 / Rhead ** 6.0d0) &
23451 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
23452 c3= (w3/ Rhead ** 6.0d0) &
23453 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23457 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
23458 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
23459 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
23460 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
23461 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23463 dGCLdR = c1 - c2 + c3
23465 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
23466 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23467 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
23468 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
23469 dGCLdOM1 = c1 - c2 + c3
23471 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
23472 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23473 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
23474 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
23476 dGCLdOM2 = c1 - c2 + c3
23478 c1 = w1 / (Rhead ** 3.0d0)
23479 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
23480 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
23481 dGCLdOM12 = c1 - c2 + c3
23483 erhead(k) = Rhead_distance(k)/Rhead
23485 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23486 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
23487 ! facd1 = d1 * vbld_inv(i+nres)
23488 ! facd2 = d2 * vbld_inv(j+nres)
23492 !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23493 ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
23496 !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
23497 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23500 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23501 - dGCLdR * erhead(k)/2.0d0
23502 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23503 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23504 - dGCLdR * erhead(k)/2.0d0
23505 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23506 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23507 + dGCLdR * erhead(k)
23509 ! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
23510 epepbase=epepbase+evdwij+Fcav+ECL
23511 call sc_grad_pepbase
23514 END SUBROUTINE epep_sc_base
23515 SUBROUTINE sc_grad_pepbase
23518 real (kind=8) :: dcosom1(3),dcosom2(3)
23520 eps2der * eps2rt_om1 &
23521 - 2.0D0 * alf1 * eps3der &
23522 + sigder * sigsq_om1 &
23528 eps2der * eps2rt_om2 &
23529 + 2.0D0 * alf2 * eps3der &
23530 + sigder * sigsq_om2 &
23536 evdwij * eps1_om12 &
23537 + eps2der * eps2rt_om12 &
23538 - 2.0D0 * alf12 * eps3der &
23539 + sigder *sigsq_om12 &
23544 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23545 ! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
23546 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23548 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23549 ! gg(1),gg(2),"rozne"
23551 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
23552 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
23553 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23554 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
23555 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23557 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23558 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
23559 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
23561 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23562 ! print *,eom12,eom2,om12,om2
23563 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23564 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23565 gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
23566 + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23567 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23568 gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
23571 END SUBROUTINE sc_grad_pepbase
23572 subroutine eprot_sc_phosphate(escpho)
23574 ! implicit real*8 (a-h,o-z)
23575 ! include 'DIMENSIONS'
23576 ! include 'COMMON.GEO'
23577 ! include 'COMMON.VAR'
23578 ! include 'COMMON.LOCAL'
23579 ! include 'COMMON.CHAIN'
23580 ! include 'COMMON.DERIV'
23581 ! include 'COMMON.NAMES'
23582 ! include 'COMMON.INTERACT'
23583 ! include 'COMMON.IOUNITS'
23584 ! include 'COMMON.CALC'
23585 ! include 'COMMON.CONTROL'
23586 ! include 'COMMON.SBRIDGE'
23588 !el local variables
23589 integer :: iint,itypi,itypi1,itypj,subchap
23590 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23591 real(kind=8) :: evdw,sig0ij
23592 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23593 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23594 sslipi,sslipj,faclip,alpha_sco
23596 real(kind=8) :: fracinbuf
23597 real (kind=8) :: escpho
23598 real (kind=8),dimension(4):: ener
23599 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23600 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23601 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23602 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23603 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23604 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23605 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23606 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23607 real(kind=8),dimension(3,2)::chead,erhead_tail
23608 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23612 ! do i=1,nres_molec(1)
23613 do i=ibond_start,ibond_end
23614 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23616 dxi = dc_norm(1,nres+i)
23617 dyi = dc_norm(2,nres+i)
23618 dzi = dc_norm(3,nres+i)
23619 dsci_inv = vbld_inv(i+nres)
23623 xi=mod(xi,boxxsize)
23624 if (xi.lt.0) xi=xi+boxxsize
23625 yi=mod(yi,boxysize)
23626 if (yi.lt.0) yi=yi+boxysize
23627 zi=mod(zi,boxzsize)
23628 if (zi.lt.0) zi=zi+boxzsize
23629 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23631 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23632 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23633 xj=(c(1,j)+c(1,j+1))/2.0
23634 yj=(c(2,j)+c(2,j+1))/2.0
23635 zj=(c(3,j)+c(3,j+1))/2.0
23636 xj=dmod(xj,boxxsize)
23637 if (xj.lt.0) xj=xj+boxxsize
23638 yj=dmod(yj,boxysize)
23639 if (yj.lt.0) yj=yj+boxysize
23640 zj=dmod(zj,boxzsize)
23641 if (zj.lt.0) zj=zj+boxzsize
23642 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23650 xj=xj_safe+xshift*boxxsize
23651 yj=yj_safe+yshift*boxysize
23652 zj=zj_safe+zshift*boxzsize
23653 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23654 if(dist_temp.lt.dist_init) then
23655 dist_init=dist_temp
23664 if (subchap.eq.1) then
23673 dxj = dc_norm( 1,j )
23674 dyj = dc_norm( 2,j )
23675 dzj = dc_norm( 3,j )
23676 dscj_inv = vbld_inv(j+1)
23679 sig0ij = sigma_scpho(itypi )
23680 chi1 = chi_scpho(itypi,1 )
23681 chi2 = chi_scpho(itypi,2 )
23684 chi12 = chi1 * chi2
23685 chip1 = chipp_scpho(itypi,1 )
23686 chip2 = chipp_scpho(itypi,2 )
23689 chip12 = chip1 * chip2
23690 chis1 = chis_scpho(itypi,1)
23691 chis2 = chis_scpho(itypi,2)
23692 chis12 = chis1 * chis2
23693 sig1 = sigmap1_scpho(itypi)
23694 sig2 = sigmap2_scpho(itypi)
23695 ! write (*,*) "sig1 = ", sig1
23696 ! write (*,*) "sig1 = ", sig1
23697 ! write (*,*) "sig2 = ", sig2
23698 ! alpha factors from Fcav/Gcav
23702 a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
23704 b1 = alphasur_scpho(1,itypi)
23706 b2 = alphasur_scpho(2,itypi)
23707 b3 = alphasur_scpho(3,itypi)
23708 b4 = alphasur_scpho(4,itypi)
23709 ! used to determine whether we want to do quadrupole calculations
23711 eps_in = epsintab_scpho(itypi)
23712 if (eps_in.eq.0.0) eps_in=1.0
23713 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
23714 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
23715 !-------------------------------------------------------------------
23716 ! tail location and distance calculations
23717 d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
23720 ! location of polar head is computed by taking hydrophobic centre
23721 ! and moving by a d1 * dc_norm vector
23722 ! see unres publications for very informative images
23723 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
23724 chead(k,2) = (c(k, j) + c(k, j+1))/2.0
23726 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23727 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23728 Rhead_distance(k) = chead(k,2) - chead(k,1)
23730 ! pitagoras (root of sum of squares)
23732 (Rhead_distance(1)*Rhead_distance(1)) &
23733 + (Rhead_distance(2)*Rhead_distance(2)) &
23734 + (Rhead_distance(3)*Rhead_distance(3)))
23735 Rhead_sq=Rhead**2.0
23736 !-------------------------------------------------------------------
23737 ! zero everything that should be zero'ed
23756 dscj_inv = vbld_inv(j+1)/2.0
23757 !dhead_scbasej(itypi,itypj)
23758 ! print *,i,j,dscj_inv,dsci_inv
23759 ! rij holds 1/(distance of Calpha atoms)
23760 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23762 !----------------------------
23764 ! this should be in elgrad_init but om's are calculated by sc_angular
23765 ! which in turn is used by older potentials
23766 ! om = omega, sqom = om^2
23769 sqom12 = om12 * om12
23771 ! now we calculate EGB - Gey-Berne
23772 ! It will be summed up in evdwij and saved in evdw
23773 sigsq = 1.0D0 / sigsq
23774 sig = sig0ij * dsqrt(sigsq)
23775 ! rij_shift = 1.0D0 / rij - sig + sig0ij
23776 rij_shift = 1.0/rij - sig + sig0ij
23777 IF (rij_shift.le.0.0D0) THEN
23781 sigder = -sig * sigsq
23782 rij_shift = 1.0D0 / rij_shift
23783 fac = rij_shift**expon
23784 c1 = fac * fac * aa_scpho(itypi)
23786 c2 = fac * bb_scpho(itypi)
23788 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23789 eps2der = eps3rt * evdwij
23790 eps3der = eps2rt * evdwij
23791 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23792 evdwij = eps2rt * eps3rt * evdwij
23793 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23794 fac = -expon * (c1 + evdwij) * rij_shift
23795 sigder = fac * sigder
23797 ! Calculate distance derivative
23801 fac = chis1 * sqom1 + chis2 * sqom2 &
23802 - 2.0d0 * chis12 * om1 * om2 * om12
23803 ! we will use pom later in Gcav, so dont mess with it!
23804 pom = 1.0d0 - chis1 * chis2 * sqom12
23805 Lambf = (1.0d0 - (fac / pom))
23806 Lambf = dsqrt(Lambf)
23807 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23808 ! write (*,*) "sparrow = ", sparrow
23809 Chif = 1.0d0/rij * sparrow
23810 ChiLambf = Chif * Lambf
23811 eagle = dsqrt(ChiLambf)
23812 bat = ChiLambf ** 11.0d0
23813 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23814 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23817 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23818 dbot = 12.0d0 * b4 * bat * Lambf
23819 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23821 ! write (*,*) "dFcav/dR = ", dFdR
23822 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23823 dbot = 12.0d0 * b4 * bat * Chif
23824 eagle = Lambf * pom
23825 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23826 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23827 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23828 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23830 dFdL = ((dtop * bot - top * dbot) / botsq)
23832 dCAVdOM1 = dFdL * ( dFdOM1 )
23833 dCAVdOM2 = dFdL * ( dFdOM2 )
23834 dCAVdOM12 = dFdL * ( dFdOM12 )
23840 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23841 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23842 ! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
23845 ! print *,pom,gg(k),dFdR
23846 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23847 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23848 - (( dFdR + gg(k) ) * pom)
23849 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23850 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23851 ! & - ( dFdR * pom )
23853 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23854 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23855 ! + (( dFdR + gg(k) ) * pom)
23856 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23857 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23858 !c! & + ( dFdR * pom )
23860 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23861 - (( dFdR + gg(k) ) * ertail(k))
23862 !c! & - ( dFdR * ertail(k))
23864 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23865 + (( dFdR + gg(k) ) * ertail(k))/2.0
23867 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23868 + (( dFdR + gg(k) ) * ertail(k))/2.0
23870 !c! & + ( dFdR * ertail(k))
23874 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23875 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23876 ! alphapol1 = alphapol_scpho(itypi)
23877 if (wqq_scpho(itypi).ne.0.0) then
23878 Qij=wqq_scpho(itypi)/eps_in
23879 alpha_sco=1.d0/alphi_scpho(itypi)
23881 Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
23882 !c! derivative of Ecl is Gcl...
23883 dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
23884 (Rhead*alpha_sco+1) ) / Rhead_sq
23885 if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
23886 else if (wqdip_scpho(2,itypi).gt.0.0d0) then
23887 w1 = wqdip_scpho(1,itypi)
23888 w2 = wqdip_scpho(2,itypi)
23891 ! pis = sig0head_scbase(itypi,itypj)
23892 ! eps_head = epshead_scbase(itypi,itypj)
23893 !c!-------------------------------------------------------------------
23895 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
23896 !c! & +dhead(1,1,itypi,itypj))**2))
23897 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
23898 !c! & +dhead(2,1,itypi,itypj))**2))
23900 !c!-------------------------------------------------------------------
23903 hawk = w2 * (1.0d0 - sqom2)
23904 Ecl = sparrow / Rhead**2.0d0 &
23905 - hawk / Rhead**4.0d0
23906 !c!-------------------------------------------------------------------
23907 if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
23910 !c! derivative of ecl is Gcl
23912 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
23913 + 4.0d0 * hawk / Rhead**5.0d0
23915 dGCLdOM1 = (w1) / (Rhead**2.0d0)
23917 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
23920 !c--------------------------------------------------------------------
23921 !c Polarization energy
23925 !c! Calculate head-to-tail distances tail is center of side-chain
23926 R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
23931 alphapol1 = alphapol_scpho(itypi)
23933 MomoFac1 = (1.0d0 - chi2 * sqom1)
23934 RR1 = R1 * R1 / MomoFac1
23935 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
23936 ! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
23937 fgb1 = sqrt( RR1 + a12sq * ee1)
23938 ! eps_inout_fac=0.0d0
23939 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
23940 ! derivative of Epol is Gpol...
23941 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
23943 dFGBdR1 = ( (R1 / MomoFac1) &
23944 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
23946 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
23947 * (2.0d0 - 0.5d0 * ee1) ) &
23949 dPOLdR1 = dPOLdFGB1 * dFGBdR1
23952 dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
23953 * (2.0d0 - 0.5d0 * ee1) ) &
23956 dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
23959 erhead(k) = Rhead_distance(k)/Rhead
23960 erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
23963 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23964 erdxj = scalar( erhead(1), dC_norm(1,j) )
23965 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
23967 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
23968 facd1 = d1i * vbld_inv(i+nres)
23969 facd2 = d1j * vbld_inv(j)
23970 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
23973 hawk = (erhead_tail(k,1) + &
23974 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
23977 ! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
23978 ! pom,(erhead_tail(k,1))
23980 ! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
23981 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23982 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23984 - dPOLdR1 * (erhead_tail(k,1))
23987 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
23988 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23990 ! + dPOLdR1 * (erhead_tail(k,1))
23994 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23995 - dGCLdR * erhead(k) &
23996 - dPOLdR1 * erhead_tail(k,1)
23997 ! & - dGLJdR * erhead(k)
23999 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
24000 + (dGCLdR * erhead(k) &
24001 + dPOLdR1 * erhead_tail(k,1))/2.0
24002 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
24003 + (dGCLdR * erhead(k) &
24004 + dPOLdR1 * erhead_tail(k,1))/2.0
24006 ! & + dGLJdR * erhead(k)
24007 ! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
24010 ! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
24011 if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
24012 "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
24013 escpho=escpho+evdwij+epol+Fcav+ECL
24020 end subroutine eprot_sc_phosphate
24021 SUBROUTINE sc_grad_scpho
24024 real (kind=8) :: dcosom1(3),dcosom2(3)
24026 eps2der * eps2rt_om1 &
24027 - 2.0D0 * alf1 * eps3der &
24028 + sigder * sigsq_om1 &
24034 eps2der * eps2rt_om2 &
24035 + 2.0D0 * alf2 * eps3der &
24036 + sigder * sigsq_om2 &
24042 evdwij * eps1_om12 &
24043 + eps2der * eps2rt_om12 &
24044 - 2.0D0 * alf12 * eps3der &
24045 + sigder *sigsq_om12 &
24050 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
24051 ! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),&
24052 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
24054 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
24055 ! gg(1),gg(2),"rozne"
24057 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
24058 dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
24059 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
24060 gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
24061 + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
24063 - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24064 gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
24065 - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
24067 + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24068 gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
24069 + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
24070 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24072 ! print *,eom12,eom2,om12,om2
24073 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
24074 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
24075 ! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
24076 ! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
24077 ! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24078 gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
24081 END SUBROUTINE sc_grad_scpho
24082 subroutine eprot_pep_phosphate(epeppho)
24084 ! implicit real*8 (a-h,o-z)
24085 ! include 'DIMENSIONS'
24086 ! include 'COMMON.GEO'
24087 ! include 'COMMON.VAR'
24088 ! include 'COMMON.LOCAL'
24089 ! include 'COMMON.CHAIN'
24090 ! include 'COMMON.DERIV'
24091 ! include 'COMMON.NAMES'
24092 ! include 'COMMON.INTERACT'
24093 ! include 'COMMON.IOUNITS'
24094 ! include 'COMMON.CALC'
24095 ! include 'COMMON.CONTROL'
24096 ! include 'COMMON.SBRIDGE'
24098 !el local variables
24099 integer :: iint,itypi,itypi1,itypj,subchap
24100 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
24101 real(kind=8) :: evdw,sig0ij
24102 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24103 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
24104 sslipi,sslipj,faclip
24106 real(kind=8) :: fracinbuf
24107 real (kind=8) :: epeppho
24108 real (kind=8),dimension(4):: ener
24109 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
24110 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
24111 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
24112 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
24113 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
24114 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
24115 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
24116 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
24117 real(kind=8),dimension(3,2)::chead,erhead_tail
24118 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
24120 real (kind=8) :: dcosom1(3),dcosom2(3)
24122 ! do i=1,nres_molec(1)
24123 do i=ibond_start,ibond_end
24124 if (itype(i,1).eq.ntyp1_molec(1)) cycle
24126 dsci_inv = vbld_inv(i+1)/2.0
24130 xi=(c(1,i)+c(1,i+1))/2.0
24131 yi=(c(2,i)+c(2,i+1))/2.0
24132 zi=(c(3,i)+c(3,i+1))/2.0
24133 xi=mod(xi,boxxsize)
24134 if (xi.lt.0) xi=xi+boxxsize
24135 yi=mod(yi,boxysize)
24136 if (yi.lt.0) yi=yi+boxysize
24137 zi=mod(zi,boxzsize)
24138 if (zi.lt.0) zi=zi+boxzsize
24139 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
24141 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
24142 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
24143 xj=(c(1,j)+c(1,j+1))/2.0
24144 yj=(c(2,j)+c(2,j+1))/2.0
24145 zj=(c(3,j)+c(3,j+1))/2.0
24146 xj=dmod(xj,boxxsize)
24147 if (xj.lt.0) xj=xj+boxxsize
24148 yj=dmod(yj,boxysize)
24149 if (yj.lt.0) yj=yj+boxysize
24150 zj=dmod(zj,boxzsize)
24151 if (zj.lt.0) zj=zj+boxzsize
24152 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24160 xj=xj_safe+xshift*boxxsize
24161 yj=yj_safe+yshift*boxysize
24162 zj=zj_safe+zshift*boxzsize
24163 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24164 if(dist_temp.lt.dist_init) then
24165 dist_init=dist_temp
24174 if (subchap.eq.1) then
24183 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24185 dxj = dc_norm( 1,j )
24186 dyj = dc_norm( 2,j )
24187 dzj = dc_norm( 3,j )
24188 dscj_inv = vbld_inv(j+1)/2.0
24190 sig0ij = sigma_peppho
24193 chi12 = chi1 * chi2
24196 chip12 = chip1 * chip2
24199 chis12 = chis1 * chis2
24200 sig1 = sigmap1_peppho
24201 sig2 = sigmap2_peppho
24202 ! write (*,*) "sig1 = ", sig1
24203 ! write (*,*) "sig1 = ", sig1
24204 ! write (*,*) "sig2 = ", sig2
24205 ! alpha factors from Fcav/Gcav
24209 b1 = alphasur_peppho(1)
24211 b2 = alphasur_peppho(2)
24212 b3 = alphasur_peppho(3)
24213 b4 = alphasur_peppho(4)
24235 fac = rij_shift**expon
24236 c1 = fac * fac * aa_peppho
24238 c2 = fac * bb_peppho
24241 ! Now cavity....................
24242 eagle = dsqrt(1.0/rij_shift)
24243 top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
24244 bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
24247 dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
24248 dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
24249 dFdR = ((dtop * bot - top * dbot) / botsq)
24250 w1 = wqdip_peppho(1)
24251 w2 = wqdip_peppho(2)
24254 ! pis = sig0head_scbase(itypi,itypj)
24255 ! eps_head = epshead_scbase(itypi,itypj)
24256 !c!-------------------------------------------------------------------
24258 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24259 !c! & +dhead(1,1,itypi,itypj))**2))
24260 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24261 !c! & +dhead(2,1,itypi,itypj))**2))
24263 !c!-------------------------------------------------------------------
24266 hawk = w2 * (1.0d0 - sqom1)
24267 Ecl = sparrow * rij_shift**2.0d0 &
24268 - hawk * rij_shift**4.0d0
24269 !c!-------------------------------------------------------------------
24270 !c! derivative of ecl is Gcl
24273 dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
24274 + 4.0d0 * hawk * rij_shift**5.0d0
24276 dGCLdOM1 = (w1) * (rij_shift**2.0d0)
24278 dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
24279 eom1 = dGCLdOM1+dGCLdOM2
24282 fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
24288 gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
24289 gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
24290 gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
24291 gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
24296 dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
24297 dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
24298 gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
24299 gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
24300 ! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24301 gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
24302 ! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24303 gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
24304 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24305 gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
24306 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24308 epeppho=epeppho+evdwij+Fcav+ECL
24309 ! print *,i,j,evdwij,Fcav,ECL,rij_shift
24312 end subroutine eprot_pep_phosphate
24313 !!!!!!!!!!!!!!!!-------------------------------------------------------------
24314 subroutine emomo(evdw)
24317 ! implicit real*8 (a-h,o-z)
24318 ! include 'DIMENSIONS'
24319 ! include 'COMMON.GEO'
24320 ! include 'COMMON.VAR'
24321 ! include 'COMMON.LOCAL'
24322 ! include 'COMMON.CHAIN'
24323 ! include 'COMMON.DERIV'
24324 ! include 'COMMON.NAMES'
24325 ! include 'COMMON.INTERACT'
24326 ! include 'COMMON.IOUNITS'
24327 ! include 'COMMON.CALC'
24328 ! include 'COMMON.CONTROL'
24329 ! include 'COMMON.SBRIDGE'
24331 !el local variables
24332 integer :: iint,itypi1,subchap,isel
24333 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
24334 real(kind=8) :: evdw
24335 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24336 dist_temp, dist_init,ssgradlipi,ssgradlipj, &
24337 sslipi,sslipj,faclip,alpha_sco
24339 real(kind=8) :: fracinbuf
24340 real (kind=8) :: escpho
24341 real (kind=8),dimension(4):: ener
24342 real(kind=8) :: b1,b2,egb
24343 real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
24345 Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
24346 dFdOM2,dFdL,dFdOM12,&
24349 ! real(kind=8),dimension(3,2)::erhead_tail
24350 ! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
24351 real(kind=8) :: facd4, adler, Fgb, facd3
24352 integer troll,jj,istate
24353 real (kind=8) :: dcosom1(3),dcosom2(3)
24356 ! print *,"EVDW KURW",evdw,nres
24357 do i=iatsc_s,iatsc_e
24358 ! print *,"I am in EVDW",i
24359 itypi=iabs(itype(i,1))
24360 ! if (i.ne.47) cycle
24361 if (itypi.eq.ntyp1) cycle
24362 itypi1=iabs(itype(i+1,1))
24366 xi=dmod(xi,boxxsize)
24367 if (xi.lt.0) xi=xi+boxxsize
24368 yi=dmod(yi,boxysize)
24369 if (yi.lt.0) yi=yi+boxysize
24370 zi=dmod(zi,boxzsize)
24371 if (zi.lt.0) zi=zi+boxzsize
24373 if ((zi.gt.bordlipbot) &
24374 .and.(zi.lt.bordliptop)) then
24375 !C the energy transfer exist
24376 if (zi.lt.buflipbot) then
24377 !C what fraction I am in
24379 ((zi-bordlipbot)/lipbufthick)
24380 !C lipbufthick is thickenes of lipid buffore
24381 sslipi=sscalelip(fracinbuf)
24382 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
24383 elseif (zi.gt.bufliptop) then
24384 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
24385 sslipi=sscalelip(fracinbuf)
24386 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
24395 ! print *, sslipi,ssgradlipi
24396 dxi=dc_norm(1,nres+i)
24397 dyi=dc_norm(2,nres+i)
24398 dzi=dc_norm(3,nres+i)
24399 ! dsci_inv=dsc_inv(itypi)
24400 dsci_inv=vbld_inv(i+nres)
24401 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
24402 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
24404 ! Calculate SC interaction energy.
24406 do iint=1,nint_gr(i)
24407 do j=istart(i,iint),iend(i,iint)
24408 ! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint)
24409 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
24410 call dyn_ssbond_ene(i,j,evdwij)
24412 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
24413 'evdw',i,j,evdwij,' ss'
24414 ! if (energy_dec) write (iout,*) &
24415 ! 'evdw',i,j,evdwij,' ss'
24416 do k=j+1,iend(i,iint)
24417 !C search over all next residues
24418 if (dyn_ss_mask(k)) then
24419 !C check if they are cysteins
24420 !C write(iout,*) 'k=',k
24422 !c write(iout,*) "PRZED TRI", evdwij
24423 ! evdwij_przed_tri=evdwij
24424 call triple_ssbond_ene(i,j,k,evdwij)
24425 !c if(evdwij_przed_tri.ne.evdwij) then
24426 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
24429 !c write(iout,*) "PO TRI", evdwij
24430 !C call the energy function that removes the artifical triple disulfide
24431 !C bond the soubroutine is located in ssMD.F
24433 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
24434 'evdw',i,j,evdwij,'tss'
24435 endif!dyn_ss_mask(k)
24439 itypj=iabs(itype(j,1))
24440 if (itypj.eq.ntyp1) cycle
24441 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
24443 ! if (j.ne.78) cycle
24444 ! dscj_inv=dsc_inv(itypj)
24445 dscj_inv=vbld_inv(j+nres)
24449 xj=dmod(xj,boxxsize)
24450 if (xj.lt.0) xj=xj+boxxsize
24451 yj=dmod(yj,boxysize)
24452 if (yj.lt.0) yj=yj+boxysize
24453 zj=dmod(zj,boxzsize)
24454 if (zj.lt.0) zj=zj+boxzsize
24455 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24464 xj=xj_safe+xshift*boxxsize
24465 yj=yj_safe+yshift*boxysize
24466 zj=zj_safe+zshift*boxzsize
24467 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24468 if(dist_temp.lt.dist_init) then
24469 dist_init=dist_temp
24478 if (subchap.eq.1) then
24487 dxj = dc_norm( 1, nres+j )
24488 dyj = dc_norm( 2, nres+j )
24489 dzj = dc_norm( 3, nres+j )
24490 ! print *,i,j,itypi,itypj
24493 ! BetaT = 1.0d0 / (298.0d0 * Rb)
24495 !1! sig0ij = sigma_scsc( itypi,itypj )
24500 ! not used by momo potential, but needed by sc_angular which is shared
24501 ! by all energy_potential subroutines
24505 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
24506 ! a12sq = a12sq * a12sq
24507 ! charge of amino acid itypi is...
24508 chis1 = chis(itypi,itypj)
24509 chis2 = chis(itypj,itypi)
24510 chis12 = chis1 * chis2
24511 sig1 = sigmap1(itypi,itypj)
24512 sig2 = sigmap2(itypi,itypj)
24513 ! write (*,*) "sig1 = ", sig1
24516 ! chis12 = chis1 * chis2
24519 ! write (*,*) "sig2 = ", sig2
24520 ! alpha factors from Fcav/Gcav
24521 b1cav = alphasur(1,itypi,itypj)
24523 b2cav = alphasur(2,itypi,itypj)
24524 b3cav = alphasur(3,itypi,itypj)
24525 b4cav = alphasur(4,itypi,itypj)
24526 ! used to determine whether we want to do quadrupole calculations
24527 eps_in = epsintab(itypi,itypj)
24528 if (eps_in.eq.0.0) eps_in=1.0
24530 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
24532 ! dtail(1,itypi,itypj)=0.0
24533 ! dtail(2,itypi,itypj)=0.0
24536 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
24537 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
24539 !c! tail distances will be themselves usefull elswhere
24540 !c1 (in Gcav, for example)
24541 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
24542 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
24543 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
24545 (Rtail_distance(1)*Rtail_distance(1)) &
24546 + (Rtail_distance(2)*Rtail_distance(2)) &
24547 + (Rtail_distance(3)*Rtail_distance(3)))
24549 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
24550 !-------------------------------------------------------------------
24551 ! tail location and distance calculations
24552 d1 = dhead(1, 1, itypi, itypj)
24553 d2 = dhead(2, 1, itypi, itypj)
24556 ! location of polar head is computed by taking hydrophobic centre
24557 ! and moving by a d1 * dc_norm vector
24558 ! see unres publications for very informative images
24559 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
24560 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
24562 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
24563 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
24564 Rhead_distance(k) = chead(k,2) - chead(k,1)
24566 ! pitagoras (root of sum of squares)
24568 (Rhead_distance(1)*Rhead_distance(1)) &
24569 + (Rhead_distance(2)*Rhead_distance(2)) &
24570 + (Rhead_distance(3)*Rhead_distance(3)))
24571 !-------------------------------------------------------------------
24572 ! zero everything that should be zero'ed
24590 dscj_inv = vbld_inv(j+nres)
24591 ! print *,i,j,dscj_inv,dsci_inv
24592 ! rij holds 1/(distance of Calpha atoms)
24593 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24595 !----------------------------
24597 ! this should be in elgrad_init but om's are calculated by sc_angular
24598 ! which in turn is used by older potentials
24599 ! om = omega, sqom = om^2
24602 sqom12 = om12 * om12
24604 ! now we calculate EGB - Gey-Berne
24605 ! It will be summed up in evdwij and saved in evdw
24606 sigsq = 1.0D0 / sigsq
24607 sig = sig0ij * dsqrt(sigsq)
24608 ! rij_shift = 1.0D0 / rij - sig + sig0ij
24609 rij_shift = Rtail - sig + sig0ij
24610 IF (rij_shift.le.0.0D0) THEN
24614 sigder = -sig * sigsq
24615 rij_shift = 1.0D0 / rij_shift
24616 fac = rij_shift**expon
24617 c1 = fac * fac * aa_aq(itypi,itypj)
24618 ! print *,"ADAM",aa_aq(itypi,itypj)
24621 c2 = fac * bb_aq(itypi,itypj)
24623 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
24624 eps2der = eps3rt * evdwij
24625 eps3der = eps2rt * evdwij
24626 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
24627 evdwij = eps2rt * eps3rt * evdwij
24629 ! IF (bb_aq(itypi,itypj).gt.0) THEN
24630 ! evdw_p = evdw_p + evdwij
24632 ! evdw_m = evdw_m + evdwij
24639 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
24640 fac = -expon * (c1 + evdwij) * rij_shift
24641 sigder = fac * sigder
24643 ! Calculate distance derivative
24647 ! if (b2.gt.0.0) then
24648 fac = chis1 * sqom1 + chis2 * sqom2 &
24649 - 2.0d0 * chis12 * om1 * om2 * om12
24650 ! we will use pom later in Gcav, so dont mess with it!
24651 pom = 1.0d0 - chis1 * chis2 * sqom12
24652 Lambf = (1.0d0 - (fac / pom))
24653 ! print *,"fac,pom",fac,pom,Lambf
24654 Lambf = dsqrt(Lambf)
24655 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24656 ! print *,"sig1,sig2",sig1,sig2,itypi,itypj
24657 ! write (*,*) "sparrow = ", sparrow
24658 Chif = Rtail * sparrow
24659 ! print *,"rij,sparrow",rij , sparrow
24660 ChiLambf = Chif * Lambf
24661 eagle = dsqrt(ChiLambf)
24662 bat = ChiLambf ** 11.0d0
24663 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
24664 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
24666 ! print *,top,bot,"bot,top",ChiLambf,Chif
24669 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
24670 dbot = 12.0d0 * b4cav * bat * Lambf
24671 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24673 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
24674 dbot = 12.0d0 * b4cav * bat * Chif
24675 eagle = Lambf * pom
24676 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24677 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24678 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24679 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24681 dFdL = ((dtop * bot - top * dbot) / botsq)
24683 dCAVdOM1 = dFdL * ( dFdOM1 )
24684 dCAVdOM2 = dFdL * ( dFdOM2 )
24685 dCAVdOM12 = dFdL * ( dFdOM12 )
24688 ertail(k) = Rtail_distance(k)/Rtail
24690 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
24691 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
24692 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
24693 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24695 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24696 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24697 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24698 gvdwx(k,i) = gvdwx(k,i) &
24699 - (( dFdR + gg(k) ) * pom)
24700 !c! & - ( dFdR * pom )
24701 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24702 gvdwx(k,j) = gvdwx(k,j) &
24703 + (( dFdR + gg(k) ) * pom)
24704 !c! & + ( dFdR * pom )
24706 gvdwc(k,i) = gvdwc(k,i) &
24707 - (( dFdR + gg(k) ) * ertail(k))
24708 !c! & - ( dFdR * ertail(k))
24710 gvdwc(k,j) = gvdwc(k,j) &
24711 + (( dFdR + gg(k) ) * ertail(k))
24712 !c! & + ( dFdR * ertail(k))
24715 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24716 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24720 !c! Compute head-head and head-tail energies for each state
24722 isel = iabs(Qi) + iabs(Qj)
24724 IF (isel.eq.0) THEN
24725 !c! No charges - do nothing
24728 ELSE IF (isel.eq.4) THEN
24729 !c! Calculate dipole-dipole interactions
24732 ! eheadtail = 0.0d0
24734 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
24735 !c! Charge-nonpolar interactions
24738 ! eheadtail = 0.0d0
24740 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
24741 !c! Nonpolar-charge interactions
24744 ! eheadtail = 0.0d0
24746 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
24747 !c! Charge-dipole interactions
24748 CALL eqd(ecl, elj, epol)
24749 eheadtail = ECL + elj + epol
24750 ! eheadtail = 0.0d0
24752 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
24753 !c! Dipole-charge interactions
24754 CALL edq(ecl, elj, epol)
24755 eheadtail = ECL + elj + epol
24756 ! eheadtail = 0.0d0
24758 ELSE IF ((isel.eq.2.and. &
24759 iabs(Qi).eq.1).and. &
24760 nstate(itypi,itypj).eq.1) THEN
24761 !c! Same charge-charge interaction ( +/+ or -/- )
24762 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
24763 eheadtail = ECL + Egb + Epol + Fisocav + Elj
24764 ! eheadtail = 0.0d0
24766 ELSE IF ((isel.eq.2.and. &
24767 iabs(Qi).eq.1).and. &
24768 nstate(itypi,itypj).ne.1) THEN
24769 !c! Different charge-charge interaction ( +/- or -/+ )
24770 CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
24772 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
24773 evdw = evdw + Fcav + eheadtail
24775 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
24776 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
24777 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
24778 Equad,evdwij+Fcav+eheadtail,evdw
24779 ! evdw = evdw + Fcav + eheadtail
24781 iF (nstate(itypi,itypj).eq.1) THEN
24784 !c!-------------------------------------------------------------------
24789 !c write (iout,*) "Number of loop steps in EGB:",ind
24790 !c energy_dec=.false.
24791 ! print *,"EVDW KURW",evdw,nres
24794 END SUBROUTINE emomo
24795 !C------------------------------------------------------------------------------------
24796 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
24799 real (kind=8) :: facd3, facd4, federmaus, adler,&
24800 Ecl,Egb,Epol,Fisocav,Elj,Fgb
24802 !c! Epol and Gpol analytical parameters
24803 alphapol1 = alphapol(itypi,itypj)
24804 alphapol2 = alphapol(itypj,itypi)
24805 !c! Fisocav and Gisocav analytical parameters
24806 al1 = alphiso(1,itypi,itypj)
24807 al2 = alphiso(2,itypi,itypj)
24808 al3 = alphiso(3,itypi,itypj)
24809 al4 = alphiso(4,itypi,itypj)
24811 / dsqrt(sigiso1(itypi, itypj)**2.0d0 &
24812 + sigiso2(itypi,itypj)**2.0d0))
24814 pis = sig0head(itypi,itypj)
24815 eps_head = epshead(itypi,itypj)
24816 Rhead_sq = Rhead * Rhead
24817 !c! R1 - distance between head of ith side chain and tail of jth sidechain
24818 !c! R2 - distance between head of jth side chain and tail of ith sidechain
24822 !c! Calculate head-to-tail distances needed by Epol
24823 R1=R1+(ctail(k,2)-chead(k,1))**2
24824 R2=R2+(chead(k,2)-ctail(k,1))**2
24830 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24831 !c! & +dhead(1,1,itypi,itypj))**2))
24832 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24833 !c! & +dhead(2,1,itypi,itypj))**2))
24835 !c!-------------------------------------------------------------------
24836 !c! Coulomb electrostatic interaction
24837 Ecl = (332.0d0 * Qij) / Rhead
24838 !c! derivative of Ecl is Gcl...
24839 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
24843 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
24844 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
24845 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
24846 ! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
24847 !c! Derivative of Egb is Ggb...
24848 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
24849 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
24850 dGGBdR = dGGBdFGB * dFGBdR
24851 !c!-------------------------------------------------------------------
24852 !c! Fisocav - isotropic cavity creation term
24853 !c! or "how much energy it costs to put charged head in water"
24855 top = al1 * (dsqrt(pom) + al2 * pom - al3)
24856 bot = (1.0d0 + al4 * pom**12.0d0)
24858 FisoCav = top / bot
24859 ! write (*,*) "Rhead = ",Rhead
24860 ! write (*,*) "csig = ",csig
24861 ! write (*,*) "pom = ",pom
24862 ! write (*,*) "al1 = ",al1
24863 ! write (*,*) "al2 = ",al2
24864 ! write (*,*) "al3 = ",al3
24865 ! write (*,*) "al4 = ",al4
24866 ! write (*,*) "top = ",top
24867 ! write (*,*) "bot = ",bot
24868 !c! Derivative of Fisocav is GCV...
24869 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
24870 dbot = 12.0d0 * al4 * pom ** 11.0d0
24871 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
24872 !c!-------------------------------------------------------------------
24874 !c! Polarization energy - charged heads polarize hydrophobic "neck"
24875 MomoFac1 = (1.0d0 - chi1 * sqom2)
24876 MomoFac2 = (1.0d0 - chi2 * sqom1)
24877 RR1 = ( R1 * R1 ) / MomoFac1
24878 RR2 = ( R2 * R2 ) / MomoFac2
24879 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
24880 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
24881 fgb1 = sqrt( RR1 + a12sq * ee1 )
24882 fgb2 = sqrt( RR2 + a12sq * ee2 )
24883 epol = 332.0d0 * eps_inout_fac * ( &
24884 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
24886 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
24888 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
24890 dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
24892 dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
24894 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
24895 * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
24896 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
24897 * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
24898 dPOLdR1 = dPOLdFGB1 * dFGBdR1
24899 !c! dPOLdR1 = 0.0d0
24900 dPOLdR2 = dPOLdFGB2 * dFGBdR2
24901 !c! dPOLdR2 = 0.0d0
24902 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
24903 !c! dPOLdOM1 = 0.0d0
24904 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
24905 !c! dPOLdOM2 = 0.0d0
24906 !c!-------------------------------------------------------------------
24908 !c! Lennard-Jones 6-12 interaction between heads
24909 pom = (pis / Rhead)**6.0d0
24910 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
24911 !c! derivative of Elj is Glj
24912 dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
24913 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
24914 !c!-------------------------------------------------------------------
24915 !c! Return the results
24916 !c! These things do the dRdX derivatives, that is
24917 !c! allow us to change what we see from function that changes with
24918 !c! distance to function that changes with LOCATION (of the interaction
24921 erhead(k) = Rhead_distance(k)/Rhead
24922 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
24923 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
24926 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24927 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24928 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
24929 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
24930 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
24931 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
24932 facd1 = d1 * vbld_inv(i+nres)
24933 facd2 = d2 * vbld_inv(j+nres)
24934 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
24935 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24937 !c! Now we add appropriate partial derivatives (one in each dimension)
24939 hawk = (erhead_tail(k,1) + &
24940 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
24941 condor = (erhead_tail(k,2) + &
24942 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
24944 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24945 gvdwx(k,i) = gvdwx(k,i) &
24950 - dPOLdR2 * (erhead_tail(k,2)&
24951 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
24954 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24955 gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom&
24956 + dGGBdR * pom+ dGCVdR * pom&
24957 + dPOLdR1 * (erhead_tail(k,1)&
24958 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
24959 + dPOLdR2 * condor + dGLJdR * pom
24961 gvdwc(k,i) = gvdwc(k,i) &
24962 - dGCLdR * erhead(k)&
24963 - dGGBdR * erhead(k)&
24964 - dGCVdR * erhead(k)&
24965 - dPOLdR1 * erhead_tail(k,1)&
24966 - dPOLdR2 * erhead_tail(k,2)&
24967 - dGLJdR * erhead(k)
24969 gvdwc(k,j) = gvdwc(k,j) &
24970 + dGCLdR * erhead(k) &
24971 + dGGBdR * erhead(k) &
24972 + dGCVdR * erhead(k) &
24973 + dPOLdR1 * erhead_tail(k,1) &
24974 + dPOLdR2 * erhead_tail(k,2)&
24975 + dGLJdR * erhead(k)
24980 !c!-------------------------------------------------------------------
24981 SUBROUTINE energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
24985 double precision eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad
24986 double precision ener(4)
24987 double precision dcosom1(3),dcosom2(3)
24988 !c! used in Epol derivatives
24989 double precision facd3, facd4
24990 double precision federmaus, adler
24991 integer istate,ii,jj
24992 real (kind=8) :: Fgb
24993 ! print *,"CALLING EQUAD"
24994 !c! Epol and Gpol analytical parameters
24995 alphapol1 = alphapol(itypi,itypj)
24996 alphapol2 = alphapol(itypj,itypi)
24997 !c! Fisocav and Gisocav analytical parameters
24998 al1 = alphiso(1,itypi,itypj)
24999 al2 = alphiso(2,itypi,itypj)
25000 al3 = alphiso(3,itypi,itypj)
25001 al4 = alphiso(4,itypi,itypj)
25002 csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0&
25003 + sigiso2(itypi,itypj)**2.0d0))
25005 w1 = wqdip(1,itypi,itypj)
25006 w2 = wqdip(2,itypi,itypj)
25007 pis = sig0head(itypi,itypj)
25008 eps_head = epshead(itypi,itypj)
25009 !c! First things first:
25010 !c! We need to do sc_grad's job with GB and Fcav
25011 eom1 = eps2der * eps2rt_om1 &
25012 - 2.0D0 * alf1 * eps3der&
25013 + sigder * sigsq_om1&
25015 eom2 = eps2der * eps2rt_om2 &
25016 + 2.0D0 * alf2 * eps3der&
25017 + sigder * sigsq_om2&
25019 eom12 = evdwij * eps1_om12 &
25020 + eps2der * eps2rt_om12 &
25021 - 2.0D0 * alf12 * eps3der&
25022 + sigder *sigsq_om12&
25024 !c! now some magical transformations to project gradient into
25025 !c! three cartesian vectors
25027 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
25028 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
25029 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
25030 !c! this acts on hydrophobic center of interaction
25031 gvdwx(k,i)= gvdwx(k,i) - gg(k) &
25032 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
25033 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
25034 gvdwx(k,j)= gvdwx(k,j) + gg(k) &
25035 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
25036 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25037 !c! this acts on Calpha
25038 gvdwc(k,i)=gvdwc(k,i)-gg(k)
25039 gvdwc(k,j)=gvdwc(k,j)+gg(k)
25041 !c! sc_grad is done, now we will compute
25046 DO istate = 1, nstate(itypi,itypj)
25047 !c*************************************************************
25048 IF (istate.ne.1) THEN
25049 IF (istate.lt.3) THEN
25055 d1 = dhead(1,ii,itypi,itypj)
25056 d2 = dhead(2,jj,itypi,itypj)
25058 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
25059 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
25060 Rhead_distance(k) = chead(k,2) - chead(k,1)
25062 !c! pitagoras (root of sum of squares)
25064 (Rhead_distance(1)*Rhead_distance(1)) &
25065 + (Rhead_distance(2)*Rhead_distance(2)) &
25066 + (Rhead_distance(3)*Rhead_distance(3)))
25068 Rhead_sq = Rhead * Rhead
25070 !c! R1 - distance between head of ith side chain and tail of jth sidechain
25071 !c! R2 - distance between head of jth side chain and tail of ith sidechain
25075 !c! Calculate head-to-tail distances
25076 R1=R1+(ctail(k,2)-chead(k,1))**2
25077 R2=R2+(chead(k,2)-ctail(k,1))**2
25082 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
25084 !c! write (*,*) "Ecl = ", Ecl
25085 !c! derivative of Ecl is Gcl...
25086 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
25091 !c!-------------------------------------------------------------------
25092 !c! Generalised Born Solvent Polarization
25093 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
25094 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
25095 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
25097 !c! write (*,*) "a1*a2 = ", a12sq
25098 !c! write (*,*) "Rhead = ", Rhead
25099 !c! write (*,*) "Rhead_sq = ", Rhead_sq
25100 !c! write (*,*) "ee = ", ee
25101 !c! write (*,*) "Fgb = ", Fgb
25102 !c! write (*,*) "fac = ", eps_inout_fac
25103 !c! write (*,*) "Qij = ", Qij
25104 !c! write (*,*) "Egb = ", Egb
25105 !c! Derivative of Egb is Ggb...
25106 !c! dFGBdR is used by Quad's later...
25107 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
25108 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
25110 dGGBdR = dGGBdFGB * dFGBdR
25112 !c!-------------------------------------------------------------------
25113 !c! Fisocav - isotropic cavity creation term
25115 top = al1 * (dsqrt(pom) + al2 * pom - al3)
25116 bot = (1.0d0 + al4 * pom**12.0d0)
25118 FisoCav = top / bot
25119 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
25120 dbot = 12.0d0 * al4 * pom ** 11.0d0
25121 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
25123 !c!-------------------------------------------------------------------
25124 !c! Polarization energy
25126 MomoFac1 = (1.0d0 - chi1 * sqom2)
25127 MomoFac2 = (1.0d0 - chi2 * sqom1)
25128 RR1 = ( R1 * R1 ) / MomoFac1
25129 RR2 = ( R2 * R2 ) / MomoFac2
25130 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25131 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
25132 fgb1 = sqrt( RR1 + a12sq * ee1 )
25133 fgb2 = sqrt( RR2 + a12sq * ee2 )
25134 epol = 332.0d0 * eps_inout_fac * (&
25135 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
25137 !c! derivative of Epol is Gpol...
25138 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
25140 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
25142 dFGBdR1 = ( (R1 / MomoFac1) &
25143 * ( 2.0d0 - (0.5d0 * ee1) ) )&
25145 dFGBdR2 = ( (R2 / MomoFac2) &
25146 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
25148 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
25149 * ( 2.0d0 - 0.5d0 * ee1) ) &
25151 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
25152 * ( 2.0d0 - 0.5d0 * ee2) ) &
25154 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25155 !c! dPOLdR1 = 0.0d0
25156 dPOLdR2 = dPOLdFGB2 * dFGBdR2
25157 !c! dPOLdR2 = 0.0d0
25158 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
25159 !c! dPOLdOM1 = 0.0d0
25160 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
25161 pom = (pis / Rhead)**6.0d0
25162 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
25164 !c! derivative of Elj is Glj
25165 dGLJdR = 4.0d0 * eps_head &
25166 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
25167 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
25169 !c!-------------------------------------------------------------------
25171 IF (Wqd.ne.0.0d0) THEN
25172 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
25173 - 37.5d0 * ( sqom1 + sqom2 ) &
25174 + 157.5d0 * ( sqom1 * sqom2 ) &
25175 - 45.0d0 * om1*om2*om12
25176 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
25177 Equad = fac * Beta1
25179 !c! derivative of Equad...
25180 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
25181 !c! dQUADdR = 0.0d0
25182 dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
25183 !c! dQUADdOM1 = 0.0d0
25184 dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
25185 !c! dQUADdOM2 = 0.0d0
25186 dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
25191 !c!-------------------------------------------------------------------
25192 !c! Return the results
25194 eom1 = dPOLdOM1 + dQUADdOM1
25195 eom2 = dPOLdOM2 + dQUADdOM2
25197 !c! now some magical transformations to project gradient into
25198 !c! three cartesian vectors
25200 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
25201 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
25202 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
25206 erhead(k) = Rhead_distance(k)/Rhead
25207 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
25208 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
25210 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25211 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
25212 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25213 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
25214 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
25215 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
25216 facd1 = d1 * vbld_inv(i+nres)
25217 facd2 = d2 * vbld_inv(j+nres)
25218 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25219 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25221 hawk = erhead_tail(k,1) + &
25222 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
25223 condor = erhead_tail(k,2) + &
25224 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
25226 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25227 !c! this acts on hydrophobic center of interaction
25228 gheadtail(k,1,1) = gheadtail(k,1,1) &
25233 - dPOLdR2 * (erhead_tail(k,2) &
25234 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
25238 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
25239 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
25241 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
25242 !c! this acts on hydrophobic center of interaction
25243 gheadtail(k,2,1) = gheadtail(k,2,1) &
25247 + dPOLdR1 * (erhead_tail(k,1) &
25248 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
25249 + dPOLdR2 * condor &
25253 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
25254 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25256 !c! this acts on Calpha
25257 gheadtail(k,3,1) = gheadtail(k,3,1) &
25258 - dGCLdR * erhead(k)&
25259 - dGGBdR * erhead(k)&
25260 - dGCVdR * erhead(k)&
25261 - dPOLdR1 * erhead_tail(k,1)&
25262 - dPOLdR2 * erhead_tail(k,2)&
25263 - dGLJdR * erhead(k) &
25264 - dQUADdR * erhead(k)&
25266 !c! this acts on Calpha
25267 gheadtail(k,4,1) = gheadtail(k,4,1) &
25268 + dGCLdR * erhead(k) &
25269 + dGGBdR * erhead(k) &
25270 + dGCVdR * erhead(k) &
25271 + dPOLdR1 * erhead_tail(k,1) &
25272 + dPOLdR2 * erhead_tail(k,2) &
25273 + dGLJdR * erhead(k) &
25274 + dQUADdR * erhead(k)&
25277 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
25278 eheadtail = eheadtail &
25279 + wstate(istate, itypi, itypj) &
25280 * dexp(-betaT * ener(istate))
25281 !c! foreach cartesian dimension
25283 !c! foreach of two gvdwx and gvdwc
25285 gheadtail(k,l,2) = gheadtail(k,l,2) &
25286 + wstate( istate, itypi, itypj ) &
25287 * dexp(-betaT * ener(istate)) &
25289 gheadtail(k,l,1) = 0.0d0
25293 !c! Here ended the gigantic DO istate = 1, 4, which starts
25294 !c! at the beggining of the subroutine
25298 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
25300 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
25301 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
25302 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
25303 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
25305 gheadtail(k,l,1) = 0.0d0
25306 gheadtail(k,l,2) = 0.0d0
25309 eheadtail = (-dlog(eheadtail)) / betaT
25316 END SUBROUTINE energy_quad
25317 !!-----------------------------------------------------------
25318 SUBROUTINE eqn(Epol)
25322 double precision facd4, federmaus,epol
25323 alphapol1 = alphapol(itypi,itypj)
25324 !c! R1 - distance between head of ith side chain and tail of jth sidechain
25327 !c! Calculate head-to-tail distances
25328 R1=R1+(ctail(k,2)-chead(k,1))**2
25333 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25334 !c! & +dhead(1,1,itypi,itypj))**2))
25335 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25336 !c! & +dhead(2,1,itypi,itypj))**2))
25337 !c--------------------------------------------------------------------
25338 !c Polarization energy
25340 MomoFac1 = (1.0d0 - chi1 * sqom2)
25341 RR1 = R1 * R1 / MomoFac1
25342 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25343 fgb1 = sqrt( RR1 + a12sq * ee1)
25344 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
25345 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
25347 dFGBdR1 = ( (R1 / MomoFac1) &
25348 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
25350 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
25351 * (2.0d0 - 0.5d0 * ee1) ) &
25353 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25354 !c! dPOLdR1 = 0.0d0
25356 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
25358 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
25360 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25361 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
25362 facd1 = d1 * vbld_inv(i+nres)
25363 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25366 hawk = (erhead_tail(k,1) + &
25367 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
25369 gvdwx(k,i) = gvdwx(k,i) &
25371 gvdwx(k,j) = gvdwx(k,j) &
25372 + dPOLdR1 * (erhead_tail(k,1) &
25373 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
25375 gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
25376 gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
25381 SUBROUTINE enq(Epol)
25384 double precision facd3, adler,epol
25385 alphapol2 = alphapol(itypj,itypi)
25386 !c! R2 - distance between head of jth side chain and tail of ith sidechain
25389 !c! Calculate head-to-tail distances
25390 R2=R2+(chead(k,2)-ctail(k,1))**2
25395 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25396 !c! & +dhead(1,1,itypi,itypj))**2))
25397 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25398 !c! & +dhead(2,1,itypi,itypj))**2))
25399 !c------------------------------------------------------------------------
25400 !c Polarization energy
25401 MomoFac2 = (1.0d0 - chi2 * sqom1)
25402 RR2 = R2 * R2 / MomoFac2
25403 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
25404 fgb2 = sqrt(RR2 + a12sq * ee2)
25405 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
25406 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
25408 dFGBdR2 = ( (R2 / MomoFac2) &
25409 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
25411 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
25412 * (2.0d0 - 0.5d0 * ee2) ) &
25414 dPOLdR2 = dPOLdFGB2 * dFGBdR2
25415 !c! dPOLdR2 = 0.0d0
25416 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
25417 !c! dPOLdOM1 = 0.0d0
25419 !c!-------------------------------------------------------------------
25420 !c! Return the results
25421 !c! (See comments in Eqq)
25423 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
25425 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
25426 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
25427 facd2 = d2 * vbld_inv(j+nres)
25428 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25430 condor = (erhead_tail(k,2) &
25431 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
25433 gvdwx(k,i) = gvdwx(k,i) &
25434 - dPOLdR2 * (erhead_tail(k,2) &
25435 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
25436 gvdwx(k,j) = gvdwx(k,j) &
25439 gvdwc(k,i) = gvdwc(k,i) &
25440 - dPOLdR2 * erhead_tail(k,2)
25441 gvdwc(k,j) = gvdwc(k,j) &
25442 + dPOLdR2 * erhead_tail(k,2)
25447 SUBROUTINE eqd(Ecl,Elj,Epol)
25450 double precision facd4, federmaus,ecl,elj,epol
25451 alphapol1 = alphapol(itypi,itypj)
25452 w1 = wqdip(1,itypi,itypj)
25453 w2 = wqdip(2,itypi,itypj)
25454 pis = sig0head(itypi,itypj)
25455 eps_head = epshead(itypi,itypj)
25456 !c!-------------------------------------------------------------------
25457 !c! R1 - distance between head of ith side chain and tail of jth sidechain
25460 !c! Calculate head-to-tail distances
25461 R1=R1+(ctail(k,2)-chead(k,1))**2
25466 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25467 !c! & +dhead(1,1,itypi,itypj))**2))
25468 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25469 !c! & +dhead(2,1,itypi,itypj))**2))
25471 !c!-------------------------------------------------------------------
25473 sparrow = w1 * Qi * om1
25474 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
25475 Ecl = sparrow / Rhead**2.0d0 &
25476 - hawk / Rhead**4.0d0
25477 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
25478 + 4.0d0 * hawk / Rhead**5.0d0
25480 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
25482 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
25483 !c--------------------------------------------------------------------
25484 !c Polarization energy
25486 MomoFac1 = (1.0d0 - chi1 * sqom2)
25487 RR1 = R1 * R1 / MomoFac1
25488 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25489 fgb1 = sqrt( RR1 + a12sq * ee1)
25490 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
25492 !c!------------------------------------------------------------------
25493 !c! derivative of Epol is Gpol...
25494 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
25496 dFGBdR1 = ( (R1 / MomoFac1) &
25497 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
25499 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
25500 * (2.0d0 - 0.5d0 * ee1) ) &
25502 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25503 !c! dPOLdR1 = 0.0d0
25505 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
25506 !c! dPOLdOM2 = 0.0d0
25507 !c!-------------------------------------------------------------------
25509 pom = (pis / Rhead)**6.0d0
25510 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
25511 !c! derivative of Elj is Glj
25512 dGLJdR = 4.0d0 * eps_head &
25513 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
25514 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
25516 erhead(k) = Rhead_distance(k)/Rhead
25517 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
25520 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25521 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
25522 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25523 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
25524 facd1 = d1 * vbld_inv(i+nres)
25525 facd2 = d2 * vbld_inv(j+nres)
25526 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25529 hawk = (erhead_tail(k,1) + &
25530 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
25532 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25533 gvdwx(k,i) = gvdwx(k,i) &
25538 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
25539 gvdwx(k,j) = gvdwx(k,j) &
25541 + dPOLdR1 * (erhead_tail(k,1) &
25542 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
25546 gvdwc(k,i) = gvdwc(k,i) &
25547 - dGCLdR * erhead(k) &
25548 - dPOLdR1 * erhead_tail(k,1) &
25549 - dGLJdR * erhead(k)
25551 gvdwc(k,j) = gvdwc(k,j) &
25552 + dGCLdR * erhead(k) &
25553 + dPOLdR1 * erhead_tail(k,1) &
25554 + dGLJdR * erhead(k)
25559 SUBROUTINE edq(Ecl,Elj,Epol)
25564 double precision facd3, adler,ecl,elj,epol
25565 alphapol2 = alphapol(itypj,itypi)
25566 w1 = wqdip(1,itypi,itypj)
25567 w2 = wqdip(2,itypi,itypj)
25568 pis = sig0head(itypi,itypj)
25569 eps_head = epshead(itypi,itypj)
25570 !c!-------------------------------------------------------------------
25571 !c! R2 - distance between head of jth side chain and tail of ith sidechain
25574 !c! Calculate head-to-tail distances
25575 R2=R2+(chead(k,2)-ctail(k,1))**2
25580 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25581 !c! & +dhead(1,1,itypi,itypj))**2))
25582 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25583 !c! & +dhead(2,1,itypi,itypj))**2))
25586 !c!-------------------------------------------------------------------
25588 sparrow = w1 * Qi * om1
25589 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
25590 ECL = sparrow / Rhead**2.0d0 &
25591 - hawk / Rhead**4.0d0
25592 !c!-------------------------------------------------------------------
25593 !c! derivative of ecl is Gcl
25595 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
25596 + 4.0d0 * hawk / Rhead**5.0d0
25598 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
25600 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
25601 !c--------------------------------------------------------------------
25602 !c Polarization energy
25604 MomoFac2 = (1.0d0 - chi2 * sqom1)
25605 RR2 = R2 * R2 / MomoFac2
25606 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
25607 fgb2 = sqrt(RR2 + a12sq * ee2)
25608 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
25609 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
25611 dFGBdR2 = ( (R2 / MomoFac2) &
25612 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
25614 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
25615 * (2.0d0 - 0.5d0 * ee2) ) &
25617 dPOLdR2 = dPOLdFGB2 * dFGBdR2
25618 !c! dPOLdR2 = 0.0d0
25619 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
25620 !c! dPOLdOM1 = 0.0d0
25622 !c!-------------------------------------------------------------------
25624 pom = (pis / Rhead)**6.0d0
25625 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
25626 !c! derivative of Elj is Glj
25627 dGLJdR = 4.0d0 * eps_head &
25628 * (((-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! (see comments in Eqq)
25634 erhead(k) = Rhead_distance(k)/Rhead
25635 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
25637 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25638 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
25639 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
25640 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
25641 facd1 = d1 * vbld_inv(i+nres)
25642 facd2 = d2 * vbld_inv(j+nres)
25643 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25645 condor = (erhead_tail(k,2) &
25646 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
25648 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25649 gvdwx(k,i) = gvdwx(k,i) &
25651 - dPOLdR2 * (erhead_tail(k,2) &
25652 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
25655 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
25656 gvdwx(k,j) = gvdwx(k,j) &
25658 + dPOLdR2 * condor &
25662 gvdwc(k,i) = gvdwc(k,i) &
25663 - dGCLdR * erhead(k) &
25664 - dPOLdR2 * erhead_tail(k,2) &
25665 - dGLJdR * erhead(k)
25667 gvdwc(k,j) = gvdwc(k,j) &
25668 + dGCLdR * erhead(k) &
25669 + dPOLdR2 * erhead_tail(k,2) &
25670 + dGLJdR * erhead(k)
25675 SUBROUTINE edd(ECL)
25680 double precision ecl
25681 !c! csig = sigiso(itypi,itypj)
25682 w1 = wqdip(1,itypi,itypj)
25683 w2 = wqdip(2,itypi,itypj)
25684 !c!-------------------------------------------------------------------
25686 fac = (om12 - 3.0d0 * om1 * om2)
25687 c1 = (w1 / (Rhead**3.0d0)) * fac
25688 c2 = (w2 / Rhead ** 6.0d0) &
25689 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
25691 !c! write (*,*) "w1 = ", w1
25692 !c! write (*,*) "w2 = ", w2
25693 !c! write (*,*) "om1 = ", om1
25694 !c! write (*,*) "om2 = ", om2
25695 !c! write (*,*) "om12 = ", om12
25696 !c! write (*,*) "fac = ", fac
25697 !c! write (*,*) "c1 = ", c1
25698 !c! write (*,*) "c2 = ", c2
25699 !c! write (*,*) "Ecl = ", Ecl
25700 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
25701 !c! write (*,*) "c2_2 = ",
25702 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
25703 !c!-------------------------------------------------------------------
25704 !c! dervative of ECL is GCL...
25706 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
25707 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
25708 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
25711 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
25712 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
25713 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
25716 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
25717 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
25718 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
25721 c1 = w1 / (Rhead ** 3.0d0)
25722 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
25723 dGCLdOM12 = c1 - c2
25724 !c!-------------------------------------------------------------------
25725 !c! Return the results
25726 !c! (see comments in Eqq)
25728 erhead(k) = Rhead_distance(k)/Rhead
25730 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25731 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
25732 facd1 = d1 * vbld_inv(i+nres)
25733 facd2 = d2 * vbld_inv(j+nres)
25736 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25737 gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom
25738 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
25739 gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom
25741 gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k)
25742 gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k)
25746 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
25751 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
25755 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
25756 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
25758 !c! BetaT = 1.0d0 / (t_bath * Rb)i
25760 BetaT = 1.0d0 / (298.0d0 * Rb)
25761 !c! Gay-berne var's
25762 sig0ij = sigma( itypi,itypj )
25763 chi1 = chi( itypi, itypj )
25764 chi2 = chi( itypj, itypi )
25765 chi12 = chi1 * chi2
25766 chip1 = chipp( itypi, itypj )
25767 chip2 = chipp( itypj, itypi )
25768 chip12 = chip1 * chip2
25775 !c! not used by momo potential, but needed by sc_angular which is shared
25776 !c! by all energy_potential subroutines
25780 !c! location, location, location
25781 ! xj = c( 1, nres+j ) - xi
25782 ! yj = c( 2, nres+j ) - yi
25783 ! zj = c( 3, nres+j ) - zi
25784 dxj = dc_norm( 1, nres+j )
25785 dyj = dc_norm( 2, nres+j )
25786 dzj = dc_norm( 3, nres+j )
25787 !c! distance from center of chain(?) to polar/charged head
25788 !c! write (*,*) "istate = ", 1
25789 !c! write (*,*) "ii = ", 1
25790 !c! write (*,*) "jj = ", 1
25791 d1 = dhead(1, 1, itypi, itypj)
25792 d2 = dhead(2, 1, itypi, itypj)
25794 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
25795 !c! a12sq = a12sq * a12sq
25796 !c! charge of amino acid itypi is...
25797 Qi = icharge(itypi)
25798 Qj = icharge(itypj)
25801 chis1 = chis(itypi,itypj)
25802 chis2 = chis(itypj,itypi)
25803 chis12 = chis1 * chis2
25804 sig1 = sigmap1(itypi,itypj)
25805 sig2 = sigmap2(itypi,itypj)
25806 !c! write (*,*) "sig1 = ", sig1
25807 !c! write (*,*) "sig2 = ", sig2
25808 !c! alpha factors from Fcav/Gcav
25809 b1cav = alphasur(1,itypi,itypj)
25811 b2cav = alphasur(2,itypi,itypj)
25812 b3cav = alphasur(3,itypi,itypj)
25813 b4cav = alphasur(4,itypi,itypj)
25814 wqd = wquad(itypi, itypj)
25816 eps_in = epsintab(itypi,itypj)
25817 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
25818 !c! write (*,*) "eps_inout_fac = ", eps_inout_fac
25819 !c!-------------------------------------------------------------------
25820 !c! tail location and distance calculations
25823 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
25824 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
25826 !c! tail distances will be themselves usefull elswhere
25827 !c1 (in Gcav, for example)
25828 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
25829 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
25830 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
25832 (Rtail_distance(1)*Rtail_distance(1)) &
25833 + (Rtail_distance(2)*Rtail_distance(2)) &
25834 + (Rtail_distance(3)*Rtail_distance(3)))
25835 !c!-------------------------------------------------------------------
25836 !c! Calculate location and distance between polar heads
25837 !c! distance between heads
25838 !c! for each one of our three dimensional space...
25839 d1 = dhead(1, 1, itypi, itypj)
25840 d2 = dhead(2, 1, itypi, itypj)
25843 !c! location of polar head is computed by taking hydrophobic centre
25844 !c! and moving by a d1 * dc_norm vector
25845 !c! see unres publications for very informative images
25846 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
25847 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
25849 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
25850 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
25851 Rhead_distance(k) = chead(k,2) - chead(k,1)
25853 !c! pitagoras (root of sum of squares)
25855 (Rhead_distance(1)*Rhead_distance(1)) &
25856 + (Rhead_distance(2)*Rhead_distance(2)) &
25857 + (Rhead_distance(3)*Rhead_distance(3)))
25858 !c!-------------------------------------------------------------------
25859 !c! zero everything that should be zero'ed
25872 END SUBROUTINE elgrad_init