2 !-----------------------------------------------------------------------------
13 !-----------------------------------------------------------------------------
14 ! Max. number of contacts per residue
16 !-----------------------------------------------------------------------------
17 ! Max. number of derivatives of virtual-bond and side-chain vectors in theta
20 !-----------------------------------------------------------------------------
21 ! Max. number of SC contacts
23 !-----------------------------------------------------------------------------
24 ! Max. number of variables
26 !-----------------------------------------------------------------------------
27 ! Max number of torsional terms in SCCOR in control_data
28 ! integer,parameter :: maxterm_sccor=6
29 !-----------------------------------------------------------------------------
30 ! Maximum number of SC local term fitting function coefficiants
31 integer,parameter :: maxsccoef=65
32 ! Maximum number of local shielding effectors
33 ! integer,parameter :: maxcontsshi=50
34 !-----------------------------------------------------------------------------
35 ! commom.calc common/calc/
36 !-----------------------------------------------------------------------------
39 ! Change 12/1/95 - common block CONTACTS1 included.
42 integer,dimension(:),allocatable :: num_cont !(maxres)
43 integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres)
44 real(kind=8),dimension(:,:),allocatable :: facont,ees0plist !(maxconts,maxres)
45 real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres)
46 integer,dimension(:),allocatable :: ishield_list
47 integer,dimension(:,:),allocatable :: shield_list
48 real(kind=8),dimension(:),allocatable :: enetube,enecavtube
50 ! 12/26/95 - H-bonding contacts
51 ! common /contacts_hb/
52 real(kind=8),dimension(:,:,:),allocatable :: gacontp_hb1,gacontp_hb2,&
53 gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres)
54 real(kind=8),dimension(:,:),allocatable :: facont_hb,ees0p,&
55 ees0m,d_cont !(maxconts,maxres)
56 integer,dimension(:),allocatable :: num_cont_hb !(maxres)
57 integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres)
58 ! 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
60 ! 7/25/08 commented out; not needed when cumulants used
61 ! Interactions of pseudo-dipoles generated by loc-el interactions.
63 real(kind=8),dimension(:,:,:),allocatable :: dip,&
64 dipderg !(4,maxconts,maxres)
65 real(kind=8),dimension(:,:,:,:,:),allocatable :: dipderx !(3,5,4,maxconts,maxres)
66 ! 10/30/99 Added other pre-computed vectors and matrices needed
67 ! to calculate three - six-order el-loc correlation terms
69 real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres)
70 real(kind=8),dimension(:,:),allocatable :: obrot,obrot2,obrot_der,&
71 obrot2_der !(2,maxres)
73 ! This common block contains vectors and matrices dependent on a single
76 real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,&
77 Ctobr,Ctobrder,Dtobr2,Dtobr2der,gUb2 !(2,maxres)
78 real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,&
79 CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
80 ! This common block contains vectors and matrices dependent on two
81 ! consecutive amino-acid residues.
83 real(kind=8),dimension(:,:),allocatable :: Ug2Db1t,Ug2Db1tder,&
84 CUgb2,CUgb2der !(2,maxres)
85 real(kind=8),dimension(:,:,:),allocatable :: EUgC,EUgCder,&
86 EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres)
87 real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,&
88 DtUg2EUgder !(2,2,2,maxres)
90 real(kind=8),dimension(4) :: gmuij,gmuij1,gmuij2,gmuji1,gmuji2
91 real(kind=8),dimension(:),allocatable :: costab,sintab,&
92 costab2,sintab2 !(maxres)
93 ! This common block contains dipole-interaction matrices and their
94 ! Cartesian derivatives.
96 real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres)
97 real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres)
99 real(kind=8),dimension(2,2,2) :: AEA,AEAderg,EAEA,AECA,&
100 AECAderg,ADtEA,ADtEA1,AEAb1,AEAb1derg,AEAb2
101 real(kind=8),dimension(2,2,2,2) :: EAEAderg,ADtEAderg,&
103 real(kind=8),dimension(2,2,3,5,2,2) :: AEAderx,EAEAderx,&
104 AECAderx,ADtEAderx,ADtEA1derx
105 real(kind=8),dimension(2,3,5,2,2,2) :: AEAb1derx,AEAb2derx
106 real(kind=8),dimension(3,2) :: g_contij
107 real(kind=8) :: ekont
108 ! 12/13/2008 (again Poland-Jaruzel war anniversary)
109 ! RE: Parallelization of 4th and higher order loc-el correlations
110 ! common /contdistrib/
111 integer,dimension(:),allocatable :: ncont_sent,ncont_recv !(maxres)
112 ! ncont_sent,ncont_recv są w multibody_ello i multibody_hb
113 !-----------------------------------------------------------------------------
116 ! real(kind=8),dimension(:,:),allocatable :: dcdv,dxdv !(6,maxdim)
117 ! real(kind=8),dimension(:,:),allocatable :: dxds !(6,maxres)
118 ! real(kind=8),dimension(:,:,:),allocatable :: gradx,gradc !(3,maxres,2)
119 real(kind=8),dimension(:,:),allocatable :: gvdwc,gelc,gelc_long,&
120 gvdwpp,gvdwc_scpp,gradx_scp,gvdwc_scp,ghpbx,ghpbc,&
121 gradcorr,gradcorr_long,gradcorr5_long,gradcorr6_long,&
122 gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6,gliptran,gliptranc,&
124 gshieldx,gshieldc,gshieldc_loc,gshieldx_ec,&
125 gshieldc_ec,gshieldc_loc_ec,gshieldx_t3, &
126 gshieldc_t3,gshieldc_loc_t3,gshieldx_t4,gshieldc_t4, &
127 gshieldc_loc_t4,gshieldx_ll,gshieldc_ll,gshieldc_loc_ll,&
128 grad_shield,gg_tube,gg_tube_sc,gradafm !(3,maxres)
129 !-----------------------------NUCLEIC GRADIENT
130 real(kind=8),dimension(:,:),allocatable ::gradb_nucl,gradbx_nucl, &
131 gvdwpsb1,gelpp,gvdwpsb,gelsbc,gelsbx,gvdwsbx,gvdwsbc,gsbloc,&
132 gsblocx,gradcorr_nucl,gradxorr_nucl,gradcorr3_nucl,gradxorr3_nucl,&
134 !-----------------------------NUCLEIC-PROTEIN GRADIENT
135 real(kind=8),dimension(:,:),allocatable :: gvdwx_scbase,gvdwc_scbase,&
136 gvdwx_pepbase,gvdwc_pepbase,gvdwx_scpho,gvdwc_scpho,&
138 !------------------------------IONS GRADIENT
139 real(kind=8),dimension(:,:),allocatable :: gradcatcat, &
140 gradpepcat,gradpepcatx,gradnuclcat,gradnuclcatx
141 ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
144 real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
145 gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
146 real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
147 gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
148 g_corr6_loc !(maxvar)
149 real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
150 real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
151 ! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
152 real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
153 ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
154 real(kind=8),dimension(:,:,:),allocatable :: grad_shield_side, &
155 grad_shield_loc ! (3,maxcontsshileding,maxnres)
158 real(kind=8), dimension(:),allocatable :: fac_shield
159 real(kind=8),dimension(3,5,2) :: derx,derx_turn
160 ! common /deriv_scloc/
161 real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
162 dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
163 dZZ_XYZtab !(3,maxres)
164 !-----------------------------------------------------------------------------
167 real(kind=8) :: gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,&
168 gradb_max,ghpbc_max,&
169 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
170 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
171 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
172 gsccorx_max,gsclocx_max
173 !-----------------------------------------------------------------------------
175 ! common /back_constr/
176 real(kind=8),dimension(:),allocatable :: dutheta,dugamma !(maxres)
177 real(kind=8),dimension(:,:),allocatable :: duscdiff,duscdiffx !(3,maxres)
179 real(kind=8) :: Ucdfrag,Ucdpair
180 real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
181 dqwol,dxqwol !(3,0:MAXRES)
182 !-----------------------------------------------------------------------------
184 ! common /dyn_ssbond/
185 real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
186 !-----------------------------------------------------------------------------
188 ! Parameters of the SCCOR term
190 real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
191 dcosomicron,domicron !(3,3,3,maxres2)
192 !-----------------------------------------------------------------------------
195 real(kind=8),dimension(:,:),allocatable :: uy,uz !(3,maxres)
196 real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
197 !-----------------------------------------------------------------------------
198 ! common /przechowalnia/
199 real(kind=8),dimension(:,:,:),allocatable :: zapas
200 real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs)
201 real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
202 !-----------------------------------------------------------------------------
203 !-----------------------------------------------------------------------------
206 !-----------------------------------------------------------------------------
208 !-----------------------------------------------------------------------------
209 ! energy_p_new_barrier.F
210 !-----------------------------------------------------------------------------
211 subroutine etotal(energia)
212 ! implicit real*8 (a-h,o-z)
213 ! include 'DIMENSIONS'
218 !MS$ATTRIBUTES C :: proc_proc
224 ! include 'COMMON.SETUP'
225 ! include 'COMMON.IOUNITS'
226 real(kind=8),dimension(0:n_ene) :: energia
227 ! include 'COMMON.LOCAL'
228 ! include 'COMMON.FFIELD'
229 ! include 'COMMON.DERIV'
230 ! include 'COMMON.INTERACT'
231 ! include 'COMMON.SBRIDGE'
232 ! include 'COMMON.CHAIN'
233 ! include 'COMMON.VAR'
234 ! include 'COMMON.MD'
235 ! include 'COMMON.CONTROL'
236 ! include 'COMMON.TIME1'
237 real(kind=8) :: time00
239 integer :: n_corr,n_corr1,ierror,imatupdate
240 real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
241 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
242 real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
243 Eafmforce,ethetacnstr
244 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
245 ! now energies for nulceic alone parameters
246 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
247 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
250 real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
252 ! energies for protein nucleic acid interaction
253 real(kind=8) :: escbase,epepbase,escpho,epeppho
256 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
257 ! shielding effect varibles for MPI
258 real(kind=8) :: fac_shieldbuf(nres), &
259 grad_shield_locbuf1(3*maxcontsshi*nres), &
260 grad_shield_sidebuf1(3*maxcontsshi*nres), &
261 grad_shield_locbuf2(3*maxcontsshi*nres), &
262 grad_shield_sidebuf2(3*maxcontsshi*nres), &
263 grad_shieldbuf1(3*nres), &
264 grad_shieldbuf2(3*nres)
266 integer ishield_listbuf(-1:nres), &
267 shield_listbuf(maxcontsshi,-1:nres),k,j,i,iii,impishi,mojint,jjj
268 ! print *,"I START ENERGY"
270 ! if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
271 ! real(kind=8), dimension(:),allocatable:: fac_shieldbuf
272 ! real(kind=8), dimension(:,:,:),allocatable:: &
273 ! grad_shield_locbuf,grad_shield_sidebuf
274 ! real(kind=8), dimension(:,:),allocatable:: &
276 ! integer, dimension(:),allocatable:: &
278 ! integer, dimension(:,:),allocatable:: shield_listbuf
280 ! if (.not.allocated(fac_shieldbuf)) then
281 ! allocate(fac_shieldbuf(nres))
282 ! allocate(grad_shield_locbuf(3,maxcontsshi,-1:nres))
283 ! allocate(grad_shield_sidebuf(3,maxcontsshi,-1:nres))
284 ! allocate(grad_shieldbuf(3,-1:nres))
285 ! allocate(ishield_listbuf(nres))
286 ! allocate(shield_listbuf(maxcontsshi,nres))
289 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
290 ! & " nfgtasks",nfgtasks
291 if (nfgtasks.gt.1) then
293 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
294 if (fg_rank.eq.0) then
295 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
296 ! print *,"Processor",myrank," BROADCAST iorder"
297 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
298 ! FG slaves as WEIGHTS array.
318 weights_(26)=wvdwpp_nucl
324 weights_(32)=wbond_nucl
325 weights_(33)=wang_nucl
327 weights_(35)=wtor_nucl
328 weights_(36)=wtor_d_nucl
329 weights_(37)=wcorr_nucl
330 weights_(38)=wcorr3_nucl
332 weights_(42)=wcatprot
334 weights_(47)=wpepbase
337 weights_(50)=wcatnucl
338 ! wcatcat= weights(41)
339 ! wcatprot=weights(42)
341 ! FG Master broadcasts the WEIGHTS_ array
342 call MPI_Bcast(weights_(1),n_ene,&
343 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
345 ! FG slaves receive the WEIGHTS array
346 call MPI_Bcast(weights(1),n_ene,&
347 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
367 wvdwpp_nucl =weights(26)
373 wbond_nucl =weights(32)
374 wang_nucl =weights(33)
376 wtor_nucl =weights(35)
377 wtor_d_nucl =weights(36)
378 wcorr_nucl =weights(37)
379 wcorr3_nucl =weights(38)
387 ! welpsb=weights(28)*fact(1)
389 ! wcorr_nucl= weights(37)*fact(1)
390 ! wcorr3_nucl=weights(38)*fact(2)
391 ! wtor_nucl= weights(35)*fact(1)
392 ! wtor_d_nucl=weights(36)*fact(2)
395 time_Bcast=time_Bcast+MPI_Wtime()-time00
396 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
397 ! call chainbuild_cart
399 ! print *,"itime_mat",itime_mat,imatupdate
400 if (nfgtasks.gt.1) then
401 call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR)
403 if (nres_molec(1).gt.0) then
404 if (mod(itime_mat,imatupdate).eq.0) call make_SCp_inter_list
405 ! write (iout,*) "after make_SCp_inter_list"
406 if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
407 ! write (iout,*) "after make_SCSC_inter_list"
409 if (mod(itime_mat,imatupdate).eq.0) call make_pp_inter_list
411 ! write (iout,*) "after make_pp_inter_list"
413 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
414 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
416 ! if (modecalc.eq.12.or.modecalc.eq.14) then
417 ! call int_from_cart1(.false.)
424 ! Compute the side-chain and electrostatic interaction energy
425 ! print *, "Before EVDW"
426 ! goto (101,102,103,104,105,106) ipot
428 ! Lennard-Jones potential.
432 !d print '(a)','Exit ELJcall el'
434 ! Lennard-Jones-Kihara potential (shifted).
435 ! 102 call eljk(evdw)
439 ! Berne-Pechukas potential (dilated LJ, angular dependence).
444 ! Gay-Berne potential (shifted LJ, angular dependence).
447 ! print *,"MOMO",scelemode
448 if (scelemode.eq.0) then
454 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
455 ! 105 call egbv(evdw)
459 ! Soft-sphere potential
460 ! 106 call e_softsphere(evdw)
462 call e_softsphere(evdw)
464 ! Calculate electrostatic (H-bonding) energy of the main chain.
468 write(iout,*)"Wrong ipot"
473 ! print *,"after EGB"
475 if (shield_mode.eq.2) then
478 if (nfgtasks.gt.1) then
479 grad_shield_sidebuf1(:)=0.0d0
480 grad_shield_locbuf1(:)=0.0d0
481 grad_shield_sidebuf2(:)=0.0d0
482 grad_shield_locbuf2(:)=0.0d0
483 grad_shieldbuf1(:)=0.0d0
484 grad_shieldbuf2(:)=0.0d0
487 write(iout,*) "befor reduce fac_shield reduce"
489 write(2,*) "fac",itype(i,1),fac_shield(i),grad_shield(1,i)
490 write(2,*) "list", shield_list(1,i),ishield_list(i), &
491 grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
500 grad_shieldbuf1(iii)=grad_shield(k,i)
507 grad_shield_sidebuf1(jjj)=grad_shield_side(k,j,i)
508 grad_shield_locbuf1(jjj)=grad_shield_loc(k,j,i)
512 call MPI_Allgatherv(fac_shield(ivec_start), &
513 ivec_count(fg_rank1), &
514 MPI_DOUBLE_PRECISION,fac_shieldbuf(1),ivec_count(0), &
516 MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
517 call MPI_Allgatherv(shield_list(1,ivec_start), &
518 ivec_count(fg_rank1), &
519 MPI_I50,shield_listbuf(1,1),ivec_count(0), &
521 MPI_I50,FG_COMM,IERROR)
522 ! write(2,*) "After I50"
524 call MPI_Allgatherv(ishield_list(ivec_start), &
525 ivec_count(fg_rank1), &
526 MPI_INTEGER,ishield_listbuf(1),ivec_count(0), &
528 MPI_INTEGER,FG_COMM,IERROR)
529 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
531 ! write(2,*) ivec_count(fg_rank1)*3,ivec_count(0)*3,ivec_displ(0)*3,3*ivec_start-2
532 ! write (2,*) "before"
533 ! write(2,*) grad_shieldbuf1
534 ! call MPI_Allgatherv(grad_shieldbuf1(3*ivec_start-2), &
535 ! ivec_count(fg_rank1)*3, &
536 ! MPI_DOUBLE_PRECISION,grad_shieldbuf2(1),ivec_count(0), &
538 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
539 call MPI_Allreduce(grad_shieldbuf1(1),grad_shieldbuf2(1), &
541 MPI_DOUBLE_PRECISION, &
544 call MPI_Allreduce(grad_shield_sidebuf1(1),grad_shield_sidebuf2(1), &
545 nres*3*maxcontsshi, &
546 MPI_DOUBLE_PRECISION, &
550 call MPI_Allreduce(grad_shield_locbuf1(1),grad_shield_locbuf2(1), &
551 nres*3*maxcontsshi, &
552 MPI_DOUBLE_PRECISION, &
557 ! write(2,*) grad_shieldbuf2
559 ! call MPI_Allgatherv(grad_shield_sidebuf1(3*maxcontsshi*ivec_start-2), &
560 ! ivec_count(fg_rank1)*3*maxcontsshi, &
561 ! MPI_DOUBLE_PRECISION,grad_shield_sidebuf2(1),ivec_count(0)*3*maxcontsshi,&
562 ! ivec_displ(0)*3*maxcontsshi, &
563 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
564 ! write(2,*) "After grad_shield_side"
566 ! call MPI_Allgatherv(grad_shield_locbuf1(3*maxcontsshi*ivec_start-2), &
567 ! ivec_count(fg_rank1)*3*maxcontsshi, &
568 ! MPI_DOUBLE_PRECISION,grad_shield_locbuf2(1),ivec_count(0)*3*maxcontsshi, &
569 ! ivec_displ(0)*3*maxcontsshi, &
570 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
571 ! write(2,*) "After MPI_SHI"
576 fac_shield(i)=fac_shieldbuf(i)
577 ishield_list(i)=ishield_listbuf(i)
578 ! write(iout,*) i,fac_shield(i)
581 grad_shield(j,i)=grad_shieldbuf2(iii)
583 do j=1,ishield_list(i)
584 ! write (iout,*) "ishild", ishield_list(i),i
585 shield_list(j,i)=shield_listbuf(j,i)
590 grad_shield_loc(k,j,i)=grad_shield_locbuf2(jjj)
591 grad_shield_side(k,j,i)=grad_shield_sidebuf2(jjj)
597 write(iout,*) "after reduce fac_shield reduce"
599 write(2,*) "fac",itype(i,1),fac_shield(i),grad_shield(1,i)
600 write(2,*) "list", shield_list(1,i),ishield_list(i), &
601 grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
609 ! print *,"AFTER EGB",ipot,evdw
611 !mc Sep-06: egb takes care of dynamic ss bonds too
613 ! if (dyn_ss) call dyn_set_nss
614 ! print *,"Processor",myrank," computed USCSC"
620 time_vec=time_vec+MPI_Wtime()-time01
626 ! print *,"Processor",myrank," left VEC_AND_DERIV"
629 ! print *,"after ipot if", ipot
630 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
631 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
632 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
633 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
635 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
636 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
637 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
638 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
640 ! print *,"just befor eelec call"
641 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
642 ! print *, "ELEC calc"
651 ! write (iout,*) "Soft-spheer ELEC potential"
652 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
655 ! print *,"Processor",myrank," computed UELEC"
657 ! Calculate excluded-volume interaction energy between peptide groups
660 ! write(iout,*) "in etotal calc exc;luded",ipot
664 call escp(evdw2,evdw2_14)
670 ! write (iout,*) "Soft-sphere SCP potential"
671 call escp_soft_sphere(evdw2,evdw2_14)
673 ! write(iout,*) "in etotal before ebond",ipot
676 ! Calculate the bond-stretching energy
679 ! print *,"EBOND",estr
680 ! write(iout,*) "in etotal afer ebond",ipot
683 ! Calculate the disulfide-bridge and other energy and the contributions
684 ! from other distance constraints.
685 ! print *,'Calling EHPB'
687 !elwrite(iout,*) "in etotal afer edis",ipot
688 ! print *,'EHPB exitted succesfully.'
690 ! Calculate the virtual-bond-angle energy.
691 ! write(iout,*) "in etotal afer edis",ipot
693 ! if (wang.gt.0.0d0) then
694 ! call ebend(ebe,ethetacnstr)
699 if (wang.gt.0d0) then
700 if (tor_mode.eq.0) then
703 !C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
711 if (with_theta_constr) call etheta_constr(ethetacnstr)
713 ! write(iout,*) "in etotal afer ebe",ipot
715 ! print *,"Processor",myrank," computed UB"
717 ! Calculate the SC local energy.
720 !elwrite(iout,*) "in etotal afer esc",ipot
721 ! print *,"Processor",myrank," computed USC"
723 ! Calculate the virtual-bond torsional energy.
725 !d print *,'nterm=',nterm
726 ! if (wtor.gt.0) then
727 ! call etor(etors,edihcnstr)
732 if (wtor.gt.0.0d0) then
733 if (tor_mode.eq.0) then
736 !C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
744 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
745 !c print *,"Processor",myrank," computed Utor"
747 ! print *,"Processor",myrank," computed Utor"
750 ! 6/23/01 Calculate double-torsional energy
752 !elwrite(iout,*) "in etotal",ipot
753 if (wtor_d.gt.0) then
758 ! print *,"Processor",myrank," computed Utord"
760 ! 21/5/07 Calculate local sicdechain correlation energy
762 if (wsccor.gt.0.0d0) then
763 call eback_sc_corr(esccor)
768 ! write(iout,*) "before multibody"
770 ! print *,"Processor",myrank," computed Usccorr"
772 ! 12/1/95 Multi-body terms
777 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
778 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
779 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
780 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
781 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
788 !elwrite(iout,*) "in etotal",ipot
789 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
790 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
791 !d write (iout,*) "multibody_hb ecorr",ecorr
793 ! write(iout,*) "afeter multibody hb"
795 ! print *,"Processor",myrank," computed Ucorr"
797 ! If performing constraint dynamics, call the constraint energy
798 ! after the equilibration time
799 if(usampl.and.totT.gt.eq_time) then
800 !elwrite(iout,*) "afeter multibody hb"
802 !elwrite(iout,*) "afeter multibody hb"
804 !elwrite(iout,*) "afeter multibody hb"
810 ! write(iout,*) "after Econstr"
812 if (wliptran.gt.0) then
813 ! print *,"PRZED WYWOLANIEM"
814 call Eliptransfer(eliptran)
818 if (fg_rank.eq.0) then
819 if (AFMlog.gt.0) then
820 call AFMforce(Eafmforce)
821 else if (selfguide.gt.0) then
822 call AFMvel(Eafmforce)
827 if (tubemode.eq.1) then
829 else if (tubemode.eq.2) then
830 call calctube2(etube)
831 elseif (tubemode.eq.3) then
836 !--------------------------------------------------------
837 ! write (iout,*) "NRES_MOLEC(2),",nres_molec(2)
838 ! print *,"before",ees,evdw1,ecorr
839 ! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
840 if (nres_molec(2).gt.0) then
841 call ebond_nucl(estr_nucl)
842 call ebend_nucl(ebe_nucl)
843 call etor_nucl(etors_nucl)
844 call esb_gb(evdwsb,eelsb)
845 call epp_nucl_sub(evdwpp,eespp)
846 call epsb(evdwpsb,eelpsb)
848 call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
849 call ecat_nucl(ecation_nucl)
866 ! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
867 ! print *,"before ecatcat",wcatcat
868 if (nres_molec(5).gt.0) then
869 if (nfgtasks.gt.1) then
870 if (fg_rank.eq.0) then
871 call ecatcat(ecationcation)
874 call ecatcat(ecationcation)
876 if (oldion.gt.0) then
877 call ecat_prot(ecation_prot)
879 call ecats_prot_amber(ecation_prot)
885 if ((nres_molec(2).gt.0).and.(nres_molec(1).gt.0)) then
886 call eprot_sc_base(escbase)
887 call epep_sc_base(epepbase)
888 call eprot_sc_phosphate(escpho)
889 call eprot_pep_phosphate(epeppho)
896 ! call ecatcat(ecationcation)
897 ! print *,"after ebend", wtor_nucl
899 time_enecalc=time_enecalc+MPI_Wtime()-time00
901 ! print *,"Processor",myrank," computed Uconstr"
910 energia(2)=evdw2-evdw2_14
927 energia(8)=eello_turn3
928 energia(9)=eello_turn4
935 energia(19)=edihcnstr
937 energia(20)=Uconst+Uconst_back
940 energia(23)=Eafmforce
941 energia(24)=ethetacnstr
943 !---------------------------------------------------------------
950 energia(32)=estr_nucl
953 energia(35)=etors_nucl
954 energia(36)=etors_d_nucl
955 energia(37)=ecorr_nucl
956 energia(38)=ecorr3_nucl
957 !----------------------------------------------------------------------
958 ! Here are the energies showed per procesor if the are more processors
959 ! per molecule then we sum it up in sum_energy subroutine
960 ! print *," Processor",myrank," calls SUM_ENERGY"
961 energia(42)=ecation_prot
962 energia(41)=ecationcation
967 ! energia(50)=ecations_prot_amber
968 energia(50)=ecation_nucl
969 call sum_energy(energia,.true.)
970 if (dyn_ss) call dyn_set_nss
971 ! print *," Processor",myrank," left SUM_ENERGY"
973 time_sumene=time_sumene+MPI_Wtime()-time00
975 ! call enerprint(energia)
976 !elwrite(iout,*)"finish etotal"
978 end subroutine etotal
979 !-----------------------------------------------------------------------------
980 subroutine sum_energy(energia,reduce)
981 ! implicit real*8 (a-h,o-z)
982 ! include 'DIMENSIONS'
986 !MS$ATTRIBUTES C :: proc_proc
992 ! include 'COMMON.SETUP'
993 ! include 'COMMON.IOUNITS'
994 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
995 ! include 'COMMON.FFIELD'
996 ! include 'COMMON.DERIV'
997 ! include 'COMMON.INTERACT'
998 ! include 'COMMON.SBRIDGE'
999 ! include 'COMMON.CHAIN'
1000 ! include 'COMMON.VAR'
1001 ! include 'COMMON.CONTROL'
1002 ! include 'COMMON.TIME1'
1004 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
1005 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
1006 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
1007 eliptran,etube, Eafmforce,ethetacnstr
1008 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
1009 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
1011 real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
1013 real(kind=8) :: escbase,epepbase,escpho,epeppho
1017 real(kind=8) :: time00
1018 if (nfgtasks.gt.1 .and. reduce) then
1021 write (iout,*) "energies before REDUCE"
1022 call enerprint(energia)
1026 enebuff(i)=energia(i)
1029 call MPI_Barrier(FG_COMM,IERR)
1030 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
1032 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
1033 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
1035 write (iout,*) "energies after REDUCE"
1036 call enerprint(energia)
1039 time_Reduce=time_Reduce+MPI_Wtime()-time00
1041 if (fg_rank.eq.0) then
1045 evdw2=energia(2)+energia(18)
1046 evdw2_14=energia(18)
1061 eello_turn3=energia(8)
1062 eello_turn4=energia(9)
1069 edihcnstr=energia(19)
1073 eliptran=energia(22)
1074 Eafmforce=energia(23)
1075 ethetacnstr=energia(24)
1083 estr_nucl=energia(32)
1084 ebe_nucl=energia(33)
1086 etors_nucl=energia(35)
1087 etors_d_nucl=energia(36)
1088 ecorr_nucl=energia(37)
1089 ecorr3_nucl=energia(38)
1090 ecation_prot=energia(42)
1091 ecationcation=energia(41)
1093 epepbase=energia(47)
1096 ecation_nucl=energia(50)
1097 ! ecations_prot_amber=energia(50)
1099 ! energia(41)=ecation_prot
1100 ! energia(42)=ecationcation
1104 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
1105 +wang*ebe+wtor*etors+wscloc*escloc &
1106 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
1107 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
1108 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
1109 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
1110 +Eafmforce+ethetacnstr &
1111 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
1112 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
1113 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
1114 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
1115 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
1116 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho+wcatnucl*ecation_nucl
1118 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
1119 +wang*ebe+wtor*etors+wscloc*escloc &
1120 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
1121 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
1122 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
1123 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
1124 +Eafmforce+ethetacnstr &
1125 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
1126 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
1127 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
1128 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
1129 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
1130 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho+wcatnucl*ecation_nucl
1136 if (isnan(etot).ne.0) energia(0)=1.0d+99
1138 if (isnan(etot)) energia(0)=1.0d+99
1143 idumm=proc_proc(etot,i)
1145 call proc_proc(etot,i)
1147 if(i.eq.1)energia(0)=1.0d+99
1152 ! call enerprint(energia)
1155 end subroutine sum_energy
1156 !-----------------------------------------------------------------------------
1157 subroutine rescale_weights(t_bath)
1158 ! implicit real*8 (a-h,o-z)
1162 ! include 'DIMENSIONS'
1163 ! include 'COMMON.IOUNITS'
1164 ! include 'COMMON.FFIELD'
1165 ! include 'COMMON.SBRIDGE'
1166 real(kind=8) :: kfac=2.4d0
1167 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
1169 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
1170 real(kind=8) :: T0=3.0d2
1173 ! facT=2*temp0/(t_bath+temp0)
1174 if (rescale_mode.eq.0) then
1181 else if (rescale_mode.eq.1) then
1182 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
1183 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1184 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1185 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1186 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1188 !#if defined(WHAM_RUN) || defined(CLUSTER)
1190 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
1191 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1192 #elif defined(FUNCT)
1198 else if (rescale_mode.eq.2) then
1204 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
1205 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
1206 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
1207 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
1208 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
1210 !#if defined(WHAM_RUN) || defined(CLUSTER)
1212 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1213 #elif defined(FUNCT)
1220 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1221 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1223 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1227 welec=weights(3)*fact(1)
1228 wcorr=weights(4)*fact(3)
1229 wcorr5=weights(5)*fact(4)
1230 wcorr6=weights(6)*fact(5)
1231 wel_loc=weights(7)*fact(2)
1232 wturn3=weights(8)*fact(2)
1233 wturn4=weights(9)*fact(3)
1234 wturn6=weights(10)*fact(5)
1235 wtor=weights(13)*fact(1)
1236 wtor_d=weights(14)*fact(2)
1237 wsccor=weights(21)*fact(1)
1238 welpsb=weights(28)*fact(1)
1239 wcorr_nucl= weights(37)*fact(1)
1240 wcorr3_nucl=weights(38)*fact(2)
1241 wtor_nucl= weights(35)*fact(1)
1242 wtor_d_nucl=weights(36)*fact(2)
1243 wpepbase=weights(47)*fact(1)
1245 end subroutine rescale_weights
1246 !-----------------------------------------------------------------------------
1247 subroutine enerprint(energia)
1248 ! implicit real*8 (a-h,o-z)
1249 ! include 'DIMENSIONS'
1250 ! include 'COMMON.IOUNITS'
1251 ! include 'COMMON.FFIELD'
1252 ! include 'COMMON.SBRIDGE'
1253 ! include 'COMMON.MD'
1254 real(kind=8) :: energia(0:n_ene)
1256 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
1257 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
1258 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
1259 etube,ethetacnstr,Eafmforce
1260 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
1261 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
1263 real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
1265 real(kind=8) :: escbase,epepbase,escpho,epeppho
1271 evdw2=energia(2)+energia(18)
1283 eello_turn3=energia(8)
1284 eello_turn4=energia(9)
1285 eello_turn6=energia(10)
1291 edihcnstr=energia(19)
1295 eliptran=energia(22)
1296 Eafmforce=energia(23)
1297 ethetacnstr=energia(24)
1305 estr_nucl=energia(32)
1306 ebe_nucl=energia(33)
1308 etors_nucl=energia(35)
1309 etors_d_nucl=energia(36)
1310 ecorr_nucl=energia(37)
1311 ecorr3_nucl=energia(38)
1312 ecation_prot=energia(42)
1313 ecationcation=energia(41)
1315 epepbase=energia(47)
1318 ecation_nucl=energia(50)
1319 ! ecations_prot_amber=energia(50)
1321 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
1322 estr,wbond,ebe,wang,&
1323 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1325 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1326 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
1327 edihcnstr,ethetacnstr,ebr*nss,&
1328 Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
1329 estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, &
1330 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
1331 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
1332 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1333 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1334 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1335 ecation_nucl,wcatnucl,etot
1336 10 format (/'Virtual-chain energies:'// &
1337 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1338 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1339 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1340 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
1341 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1342 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1343 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1344 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1345 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1346 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1347 ' (SS bridges & dist. cnstr.)'/ &
1348 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1349 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1350 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1351 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1352 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1353 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1354 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1355 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1356 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1357 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1358 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1359 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
1360 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
1361 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1362 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1363 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1364 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1365 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1366 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1367 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1368 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1369 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1370 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1371 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1372 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1373 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1374 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1375 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1376 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1377 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1378 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1379 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1380 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1381 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1382 'ECATBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(cation nucl-base)'/&
1383 'ETOT= ',1pE16.6,' (total)')
1385 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
1386 estr,wbond,ebe,wang,&
1387 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1389 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1390 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
1391 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforce, &
1393 estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
1394 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
1395 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
1396 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1397 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1398 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1399 ecation_nucl,wcatnucl,etot
1400 10 format (/'Virtual-chain energies:'// &
1401 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1402 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1403 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1404 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1405 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1406 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1407 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1408 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1409 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1410 ' (SS bridges & dist. cnstr.)'/ &
1411 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1412 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1413 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1414 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1415 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1416 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1417 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1418 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1419 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1420 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1421 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1422 'UCONST=',1pE16.6,' (Constraint energy)'/ &
1423 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
1424 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1425 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1426 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1427 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1428 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1429 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1430 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1431 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1432 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1433 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1434 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1435 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1436 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1437 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1438 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1439 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1440 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1441 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1442 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1443 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1444 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1445 'ECATBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(cation nucl-base)'/&
1446 'ETOT= ',1pE16.6,' (total)')
1449 end subroutine enerprint
1450 !-----------------------------------------------------------------------------
1451 subroutine elj(evdw)
1453 ! This subroutine calculates the interaction energy of nonbonded side chains
1454 ! assuming the LJ potential of interaction.
1456 ! implicit real*8 (a-h,o-z)
1457 ! include 'DIMENSIONS'
1458 real(kind=8),parameter :: accur=1.0d-10
1459 ! include 'COMMON.GEO'
1460 ! include 'COMMON.VAR'
1461 ! include 'COMMON.LOCAL'
1462 ! include 'COMMON.CHAIN'
1463 ! include 'COMMON.DERIV'
1464 ! include 'COMMON.INTERACT'
1465 ! include 'COMMON.TORSION'
1466 ! include 'COMMON.SBRIDGE'
1467 ! include 'COMMON.NAMES'
1468 ! include 'COMMON.IOUNITS'
1469 ! include 'COMMON.CONTACTS'
1470 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1471 integer :: num_conti
1473 integer :: i,itypi,iint,j,itypi1,itypj,k
1474 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij,sslipi,ssgradlipi,&
1475 aa,bb,sslipj,ssgradlipj
1476 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
1477 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
1479 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1481 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
1482 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
1483 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
1484 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
1486 do i=iatsc_s,iatsc_e
1487 itypi=iabs(itype(i,1))
1488 if (itypi.eq.ntyp1) cycle
1489 itypi1=iabs(itype(i+1,1))
1493 call to_box(xi,yi,zi)
1494 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1499 ! Calculate SC interaction energy.
1501 do iint=1,nint_gr(i)
1502 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1503 !d & 'iend=',iend(i,iint)
1504 do j=istart(i,iint),iend(i,iint)
1505 itypj=iabs(itype(j,1))
1506 if (itypj.eq.ntyp1) cycle
1510 call to_box(xj,yj,zj)
1511 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1512 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1513 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1514 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1515 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1516 xj=boxshift(xj-xi,boxxsize)
1517 yj=boxshift(yj-yi,boxysize)
1518 zj=boxshift(zj-zi,boxzsize)
1519 ! Change 12/1/95 to calculate four-body interactions
1520 rij=xj*xj+yj*yj+zj*zj
1522 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1523 eps0ij=eps(itypi,itypj)
1525 e1=fac*fac*aa_aq(itypi,itypj)
1526 e2=fac*bb_aq(itypi,itypj)
1528 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1529 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1530 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1531 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1532 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1533 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1536 ! Calculate the components of the gradient in DC and X
1538 fac=-rrij*(e1+evdwij)
1543 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1544 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1545 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1546 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1550 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1554 ! 12/1/95, revised on 5/20/97
1556 ! Calculate the contact function. The ith column of the array JCONT will
1557 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1558 ! greater than I). The arrays FACONT and GACONT will contain the values of
1559 ! the contact function and its derivative.
1561 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1562 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1563 ! Uncomment next line, if the correlation interactions are contact function only
1564 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1566 sigij=sigma(itypi,itypj)
1567 r0ij=rs0(itypi,itypj)
1569 ! Check whether the SC's are not too far to make a contact.
1572 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1573 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1575 if (fcont.gt.0.0D0) then
1576 ! If the SC-SC distance if close to sigma, apply spline.
1577 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1578 !Adam & fcont1,fprimcont1)
1579 !Adam fcont1=1.0d0-fcont1
1580 !Adam if (fcont1.gt.0.0d0) then
1581 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1582 !Adam fcont=fcont*fcont1
1584 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1585 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1587 !ga gg(k)=gg(k)*eps0ij
1589 !ga eps0ij=-evdwij*eps0ij
1590 ! Uncomment for AL's type of SC correlation interactions.
1591 !adam eps0ij=-evdwij
1592 num_conti=num_conti+1
1593 jcont(num_conti,i)=j
1594 facont(num_conti,i)=fcont*eps0ij
1595 fprimcont=eps0ij*fprimcont/rij
1597 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1598 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1599 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1600 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1601 gacont(1,num_conti,i)=-fprimcont*xj
1602 gacont(2,num_conti,i)=-fprimcont*yj
1603 gacont(3,num_conti,i)=-fprimcont*zj
1604 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1605 !d write (iout,'(2i3,3f10.5)')
1606 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1612 num_cont(i)=num_conti
1616 gvdwc(j,i)=expon*gvdwc(j,i)
1617 gvdwx(j,i)=expon*gvdwx(j,i)
1620 !******************************************************************************
1624 ! To save time, the factor of EXPON has been extracted from ALL components
1625 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1628 !******************************************************************************
1631 !-----------------------------------------------------------------------------
1632 subroutine eljk(evdw)
1634 ! This subroutine calculates the interaction energy of nonbonded side chains
1635 ! assuming the LJK potential of interaction.
1637 ! implicit real*8 (a-h,o-z)
1638 ! include 'DIMENSIONS'
1639 ! include 'COMMON.GEO'
1640 ! include 'COMMON.VAR'
1641 ! include 'COMMON.LOCAL'
1642 ! include 'COMMON.CHAIN'
1643 ! include 'COMMON.DERIV'
1644 ! include 'COMMON.INTERACT'
1645 ! include 'COMMON.IOUNITS'
1646 ! include 'COMMON.NAMES'
1647 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1650 integer :: i,iint,j,itypi,itypi1,k,itypj
1651 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij, &
1652 sslipi,ssgradlipi, sslipj,ssgradlipj, aa, bb
1653 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1655 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1657 do i=iatsc_s,iatsc_e
1658 itypi=iabs(itype(i,1))
1659 if (itypi.eq.ntyp1) cycle
1660 itypi1=iabs(itype(i+1,1))
1664 call to_box(xi,yi,zi)
1665 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1668 ! Calculate SC interaction energy.
1670 do iint=1,nint_gr(i)
1671 do j=istart(i,iint),iend(i,iint)
1672 itypj=iabs(itype(j,1))
1673 if (itypj.eq.ntyp1) cycle
1677 call to_box(xj,yj,zj)
1678 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1679 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1680 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1681 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1682 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1683 xj=boxshift(xj-xi,boxxsize)
1684 yj=boxshift(yj-yi,boxysize)
1685 zj=boxshift(zj-zi,boxzsize)
1686 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1687 fac_augm=rrij**expon
1688 e_augm=augm(itypi,itypj)*fac_augm
1689 r_inv_ij=dsqrt(rrij)
1691 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1692 fac=r_shift_inv**expon
1693 e1=fac*fac*aa_aq(itypi,itypj)
1694 e2=fac*bb_aq(itypi,itypj)
1696 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1697 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1698 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1699 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1700 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1701 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1702 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1705 ! Calculate the components of the gradient in DC and X
1707 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1712 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1713 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1714 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1715 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1719 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1727 gvdwc(j,i)=expon*gvdwc(j,i)
1728 gvdwx(j,i)=expon*gvdwx(j,i)
1733 !-----------------------------------------------------------------------------
1734 subroutine ebp(evdw)
1736 ! This subroutine calculates the interaction energy of nonbonded side chains
1737 ! assuming the Berne-Pechukas potential of interaction.
1741 ! implicit real*8 (a-h,o-z)
1742 ! include 'DIMENSIONS'
1743 ! include 'COMMON.GEO'
1744 ! include 'COMMON.VAR'
1745 ! include 'COMMON.LOCAL'
1746 ! include 'COMMON.CHAIN'
1747 ! include 'COMMON.DERIV'
1748 ! include 'COMMON.NAMES'
1749 ! include 'COMMON.INTERACT'
1750 ! include 'COMMON.IOUNITS'
1751 ! include 'COMMON.CALC'
1753 !el integer :: icall
1754 !el common /srutu/ icall
1755 ! double precision rrsave(maxdim)
1758 integer :: iint,itypi,itypi1,itypj
1759 real(kind=8) :: rrij,xi,yi,zi, sslipi,ssgradlipi, sslipj, &
1761 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1763 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1765 ! if (icall.eq.0) then
1771 do i=iatsc_s,iatsc_e
1772 itypi=iabs(itype(i,1))
1773 if (itypi.eq.ntyp1) cycle
1774 itypi1=iabs(itype(i+1,1))
1778 call to_box(xi,yi,zi)
1779 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1780 dxi=dc_norm(1,nres+i)
1781 dyi=dc_norm(2,nres+i)
1782 dzi=dc_norm(3,nres+i)
1783 ! dsci_inv=dsc_inv(itypi)
1784 dsci_inv=vbld_inv(i+nres)
1786 ! Calculate SC interaction energy.
1788 do iint=1,nint_gr(i)
1789 do j=istart(i,iint),iend(i,iint)
1791 itypj=iabs(itype(j,1))
1792 if (itypj.eq.ntyp1) cycle
1793 ! dscj_inv=dsc_inv(itypj)
1794 dscj_inv=vbld_inv(j+nres)
1795 chi1=chi(itypi,itypj)
1796 chi2=chi(itypj,itypi)
1803 alf12=0.5D0*(alf1+alf2)
1804 ! For diagnostics only!!!
1817 call to_box(xj,yj,zj)
1818 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1819 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1820 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1821 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1822 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1823 xj=boxshift(xj-xi,boxxsize)
1824 yj=boxshift(yj-yi,boxysize)
1825 zj=boxshift(zj-zi,boxzsize)
1826 dxj=dc_norm(1,nres+j)
1827 dyj=dc_norm(2,nres+j)
1828 dzj=dc_norm(3,nres+j)
1829 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1830 !d if (icall.eq.0) then
1836 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1838 ! Calculate whole angle-dependent part of epsilon and contributions
1839 ! to its derivatives
1840 fac=(rrij*sigsq)**expon2
1841 e1=fac*fac*aa_aq(itypi,itypj)
1842 e2=fac*bb_aq(itypi,itypj)
1843 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1844 eps2der=evdwij*eps3rt
1845 eps3der=evdwij*eps2rt
1846 evdwij=evdwij*eps2rt*eps3rt
1849 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1850 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1851 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1852 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1853 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1854 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1855 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1858 ! Calculate gradient components.
1859 e1=e1*eps1*eps2rt**2*eps3rt**2
1860 fac=-expon*(e1+evdwij)
1863 ! Calculate radial part of the gradient
1867 ! Calculate the angular part of the gradient and sum add the contributions
1868 ! to the appropriate components of the Cartesian gradient.
1876 !-----------------------------------------------------------------------------
1877 subroutine egb(evdw)
1879 ! This subroutine calculates the interaction energy of nonbonded side chains
1880 ! assuming the Gay-Berne potential of interaction.
1883 ! implicit real*8 (a-h,o-z)
1884 ! include 'DIMENSIONS'
1885 ! include 'COMMON.GEO'
1886 ! include 'COMMON.VAR'
1887 ! include 'COMMON.LOCAL'
1888 ! include 'COMMON.CHAIN'
1889 ! include 'COMMON.DERIV'
1890 ! include 'COMMON.NAMES'
1891 ! include 'COMMON.INTERACT'
1892 ! include 'COMMON.IOUNITS'
1893 ! include 'COMMON.CALC'
1894 ! include 'COMMON.CONTROL'
1895 ! include 'COMMON.SBRIDGE'
1898 integer :: iint,itypi,itypi1,itypj,subchap,icont
1899 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1900 real(kind=8) :: evdw,sig0ij
1901 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1902 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1903 sslipi,sslipj,faclip
1905 real(kind=8) :: fracinbuf
1907 !cccc energy_dec=.false.
1908 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1911 ! if (icall.eq.0) lprn=.false.
1919 ! write (iout,*) "RWA", g_listscsc_start,g_listscsc_end,i,j
1920 if (nres_molec(1).eq.0) return
1921 do icont=g_listscsc_start,g_listscsc_end
1922 i=newcontlisti(icont)
1923 j=newcontlistj(icont)
1924 ! write (iout,*) "RWA", g_listscsc_start,g_listscsc_end,i,j
1925 ! do i=iatsc_s,iatsc_e
1926 !C print *,"I am in EVDW",i
1927 itypi=iabs(itype(i,1))
1928 ! if (i.ne.47) cycle
1929 if (itypi.eq.ntyp1) cycle
1930 itypi1=iabs(itype(i+1,1))
1934 call to_box(xi,yi,zi)
1935 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1937 dxi=dc_norm(1,nres+i)
1938 dyi=dc_norm(2,nres+i)
1939 dzi=dc_norm(3,nres+i)
1940 ! dsci_inv=dsc_inv(itypi)
1941 dsci_inv=vbld_inv(i+nres)
1942 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1943 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1945 ! Calculate SC interaction energy.
1947 ! do iint=1,nint_gr(i)
1948 ! do j=istart(i,iint),iend(i,iint)
1949 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1950 call dyn_ssbond_ene(i,j,evdwij)
1952 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1953 'evdw',i,j,evdwij,' ss'
1954 ! if (energy_dec) write (iout,*) &
1955 ! 'evdw',i,j,evdwij,' ss'
1957 !C search over all next residues
1958 if (dyn_ss_mask(k)) then
1959 !C check if they are cysteins
1960 !C write(iout,*) 'k=',k
1962 !c write(iout,*) "PRZED TRI", evdwij
1963 ! evdwij_przed_tri=evdwij
1964 call triple_ssbond_ene(i,j,k,evdwij)
1965 !c if(evdwij_przed_tri.ne.evdwij) then
1966 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1969 !c write(iout,*) "PO TRI", evdwij
1970 !C call the energy function that removes the artifical triple disulfide
1971 !C bond the soubroutine is located in ssMD.F
1973 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1974 'evdw',i,j,evdwij,'tss'
1975 endif!dyn_ss_mask(k)
1979 itypj=iabs(itype(j,1))
1980 if (itypj.eq.ntyp1) cycle
1981 ! if (j.ne.78) cycle
1982 ! dscj_inv=dsc_inv(itypj)
1983 dscj_inv=vbld_inv(j+nres)
1984 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1985 ! 1.0d0/vbld(j+nres) !d
1986 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1987 sig0ij=sigma(itypi,itypj)
1988 chi1=chi(itypi,itypj)
1989 chi2=chi(itypj,itypi)
1996 alf12=0.5D0*(alf1+alf2)
1997 ! For diagnostics only!!!
2010 call to_box(xj,yj,zj)
2011 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
2012 ! write (iout,*) "KWA2", itypi,itypj
2013 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
2014 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2015 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
2016 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2017 xj=boxshift(xj-xi,boxxsize)
2018 yj=boxshift(yj-yi,boxysize)
2019 zj=boxshift(zj-zi,boxzsize)
2020 dxj=dc_norm(1,nres+j)
2021 dyj=dc_norm(2,nres+j)
2022 dzj=dc_norm(3,nres+j)
2023 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
2024 ! write (iout,*) "j",j," dc_norm",& !d
2025 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
2026 ! write(iout,*)"rrij ",rrij
2027 ! write(iout,*)"xj yj zj ", xj, yj, zj
2028 ! write(iout,*)"xi yi zi ", xi, yi, zi
2029 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
2030 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2032 sss_ele_cut=sscale_ele(1.0d0/(rij))
2033 sss_ele_grad=sscagrad_ele(1.0d0/(rij))
2034 ! print *,sss_ele_cut,sss_ele_grad,&
2035 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
2036 if (sss_ele_cut.le.0.0) cycle
2037 ! Calculate angle-dependent terms of energy and contributions to their
2041 sig=sig0ij*dsqrt(sigsq)
2042 rij_shift=1.0D0/rij-sig+sig0ij
2043 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
2045 ! for diagnostics; uncomment
2046 ! rij_shift=1.2*sig0ij
2047 ! I hate to put IF's in the loops, but here don't have another choice!!!!
2048 if (rij_shift.le.0.0D0) then
2050 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2051 !d & restyp(itypi,1),i,restyp(itypj,1),j,
2052 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
2056 !---------------------------------------------------------------
2057 rij_shift=1.0D0/rij_shift
2058 fac=rij_shift**expon
2060 e1=fac*fac*aa!(itypi,itypj)
2061 e2=fac*bb!(itypi,itypj)
2062 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2063 eps2der=evdwij*eps3rt
2064 eps3der=evdwij*eps2rt
2065 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
2066 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
2067 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
2068 evdwij=evdwij*eps2rt*eps3rt
2069 evdw=evdw+evdwij*sss_ele_cut
2071 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2072 epsi=bb**2/aa!(itypi,itypj)
2073 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
2074 restyp(itypi,1),i,restyp(itypj,1),j, &
2075 epsi,sigm,chi1,chi2,chip1,chip2, &
2076 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
2077 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
2081 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
2082 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
2083 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
2084 ! if (energy_dec) write (iout,*) &
2086 ! print *,"ZALAMKA", evdw
2088 ! Calculate gradient components.
2089 e1=e1*eps1*eps2rt**2*eps3rt**2
2090 fac=-expon*(e1+evdwij)*rij_shift
2093 ! print *,'before fac',fac,rij,evdwij
2094 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
2096 ! print *,'grad part scale',fac, &
2097 ! evdwij*sss_ele_grad/sss_ele_cut &
2098 ! /sigma(itypi,itypj)*rij
2100 ! Calculate the radial part of the gradient
2104 !C Calculate the radial part of the gradient
2105 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
2106 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
2107 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
2108 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
2109 gg_lipj(3)=ssgradlipj*gg_lipi(3)
2110 gg_lipi(3)=gg_lipi(3)*ssgradlipi
2112 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
2113 ! Calculate angular part of the gradient.
2119 ! print *,"ZALAMKA", evdw
2120 ! write (iout,*) "Number of loop steps in EGB:",ind
2121 !ccc energy_dec=.false.
2124 !-----------------------------------------------------------------------------
2125 subroutine egbv(evdw)
2127 ! This subroutine calculates the interaction energy of nonbonded side chains
2128 ! assuming the Gay-Berne-Vorobjev potential of interaction.
2132 ! implicit real*8 (a-h,o-z)
2133 ! include 'DIMENSIONS'
2134 ! include 'COMMON.GEO'
2135 ! include 'COMMON.VAR'
2136 ! include 'COMMON.LOCAL'
2137 ! include 'COMMON.CHAIN'
2138 ! include 'COMMON.DERIV'
2139 ! include 'COMMON.NAMES'
2140 ! include 'COMMON.INTERACT'
2141 ! include 'COMMON.IOUNITS'
2142 ! include 'COMMON.CALC'
2144 !el integer :: icall
2145 !el common /srutu/ icall
2148 integer :: iint,itypi,itypi1,itypj
2149 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2, &
2150 sigm,sslipi,ssgradlipi, sslipj,ssgradlipj, aa, bb
2151 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
2153 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
2156 ! if (icall.eq.0) lprn=.true.
2158 do i=iatsc_s,iatsc_e
2159 itypi=iabs(itype(i,1))
2160 if (itypi.eq.ntyp1) cycle
2161 itypi1=iabs(itype(i+1,1))
2165 call to_box(xi,yi,zi)
2166 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
2167 dxi=dc_norm(1,nres+i)
2168 dyi=dc_norm(2,nres+i)
2169 dzi=dc_norm(3,nres+i)
2170 ! dsci_inv=dsc_inv(itypi)
2171 dsci_inv=vbld_inv(i+nres)
2173 ! Calculate SC interaction energy.
2175 do iint=1,nint_gr(i)
2176 do j=istart(i,iint),iend(i,iint)
2178 itypj=iabs(itype(j,1))
2179 if (itypj.eq.ntyp1) cycle
2180 ! dscj_inv=dsc_inv(itypj)
2181 dscj_inv=vbld_inv(j+nres)
2182 sig0ij=sigma(itypi,itypj)
2183 r0ij=r0(itypi,itypj)
2184 chi1=chi(itypi,itypj)
2185 chi2=chi(itypj,itypi)
2192 alf12=0.5D0*(alf1+alf2)
2193 ! For diagnostics only!!!
2206 call to_box(xj,yj,zj)
2207 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
2208 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
2209 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2210 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
2211 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2212 xj=boxshift(xj-xi,boxxsize)
2213 yj=boxshift(yj-yi,boxysize)
2214 zj=boxshift(zj-zi,boxzsize)
2215 dxj=dc_norm(1,nres+j)
2216 dyj=dc_norm(2,nres+j)
2217 dzj=dc_norm(3,nres+j)
2218 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2220 ! Calculate angle-dependent terms of energy and contributions to their
2224 sig=sig0ij*dsqrt(sigsq)
2225 rij_shift=1.0D0/rij-sig+r0ij
2226 ! I hate to put IF's in the loops, but here don't have another choice!!!!
2227 if (rij_shift.le.0.0D0) then
2232 !---------------------------------------------------------------
2233 rij_shift=1.0D0/rij_shift
2234 fac=rij_shift**expon
2235 e1=fac*fac*aa_aq(itypi,itypj)
2236 e2=fac*bb_aq(itypi,itypj)
2237 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2238 eps2der=evdwij*eps3rt
2239 eps3der=evdwij*eps2rt
2240 fac_augm=rrij**expon
2241 e_augm=augm(itypi,itypj)*fac_augm
2242 evdwij=evdwij*eps2rt*eps3rt
2243 evdw=evdw+evdwij+e_augm
2245 sigm=dabs(aa_aq(itypi,itypj)/&
2246 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
2247 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
2248 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
2249 restyp(itypi,1),i,restyp(itypj,1),j,&
2250 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
2251 chi1,chi2,chip1,chip2,&
2252 eps1,eps2rt**2,eps3rt**2,&
2253 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
2256 ! Calculate gradient components.
2257 e1=e1*eps1*eps2rt**2*eps3rt**2
2258 fac=-expon*(e1+evdwij)*rij_shift
2260 fac=rij*fac-2*expon*rrij*e_augm
2261 ! Calculate the radial part of the gradient
2265 ! Calculate angular part of the gradient.
2271 !-----------------------------------------------------------------------------
2272 !el subroutine sc_angular in module geometry
2273 !-----------------------------------------------------------------------------
2274 subroutine e_softsphere(evdw)
2276 ! This subroutine calculates the interaction energy of nonbonded side chains
2277 ! assuming the LJ potential of interaction.
2279 ! implicit real*8 (a-h,o-z)
2280 ! include 'DIMENSIONS'
2281 real(kind=8),parameter :: accur=1.0d-10
2282 ! include 'COMMON.GEO'
2283 ! include 'COMMON.VAR'
2284 ! include 'COMMON.LOCAL'
2285 ! include 'COMMON.CHAIN'
2286 ! include 'COMMON.DERIV'
2287 ! include 'COMMON.INTERACT'
2288 ! include 'COMMON.TORSION'
2289 ! include 'COMMON.SBRIDGE'
2290 ! include 'COMMON.NAMES'
2291 ! include 'COMMON.IOUNITS'
2292 ! include 'COMMON.CONTACTS'
2293 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
2294 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2296 integer :: i,iint,j,itypi,itypi1,itypj,k
2297 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
2301 do i=iatsc_s,iatsc_e
2302 itypi=iabs(itype(i,1))
2303 if (itypi.eq.ntyp1) cycle
2304 itypi1=iabs(itype(i+1,1))
2308 call to_box(xi,yi,zi)
2311 ! Calculate SC interaction energy.
2313 do iint=1,nint_gr(i)
2314 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2315 !d & 'iend=',iend(i,iint)
2316 do j=istart(i,iint),iend(i,iint)
2317 itypj=iabs(itype(j,1))
2318 if (itypj.eq.ntyp1) cycle
2319 xj=boxshift(c(1,nres+j)-xi,boxxsize)
2320 yj=boxshift(c(2,nres+j)-yi,boxysize)
2321 zj=boxshift(c(3,nres+j)-zi,boxzsize)
2322 rij=xj*xj+yj*yj+zj*zj
2323 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2324 r0ij=r0(itypi,itypj)
2326 ! print *,i,j,r0ij,dsqrt(rij)
2327 if (rij.lt.r0ijsq) then
2328 evdwij=0.25d0*(rij-r0ijsq)**2
2336 ! Calculate the components of the gradient in DC and X
2342 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2343 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2344 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2345 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2349 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2356 end subroutine e_softsphere
2357 !-----------------------------------------------------------------------------
2358 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2360 ! Soft-sphere potential of p-p interaction
2362 ! implicit real*8 (a-h,o-z)
2363 ! include 'DIMENSIONS'
2364 ! include 'COMMON.CONTROL'
2365 ! include 'COMMON.IOUNITS'
2366 ! include 'COMMON.GEO'
2367 ! include 'COMMON.VAR'
2368 ! include 'COMMON.LOCAL'
2369 ! include 'COMMON.CHAIN'
2370 ! include 'COMMON.DERIV'
2371 ! include 'COMMON.INTERACT'
2372 ! include 'COMMON.CONTACTS'
2373 ! include 'COMMON.TORSION'
2374 ! include 'COMMON.VECTORS'
2375 ! include 'COMMON.FFIELD'
2376 real(kind=8),dimension(3) :: ggg
2377 !d write(iout,*) 'In EELEC_soft_sphere'
2379 integer :: i,j,k,num_conti,iteli,itelj
2380 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2381 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
2382 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
2390 do i=iatel_s,iatel_e
2391 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2395 xmedi=c(1,i)+0.5d0*dxi
2396 ymedi=c(2,i)+0.5d0*dyi
2397 zmedi=c(3,i)+0.5d0*dzi
2398 call to_box(xmedi,ymedi,zmedi)
2400 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2401 do j=ielstart(i),ielend(i)
2402 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
2406 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2407 r0ij=rpp(iteli,itelj)
2412 xj=c(1,j)+0.5D0*dxj-xmedi
2413 yj=c(2,j)+0.5D0*dyj-ymedi
2414 zj=c(3,j)+0.5D0*dzj-zmedi
2415 call to_box(xj,yj,zj)
2416 xj=boxshift(xj-xmedi,boxxsize)
2417 yj=boxshift(yj-ymedi,boxysize)
2418 zj=boxshift(zj-zmedi,boxzsize)
2419 rij=xj*xj+yj*yj+zj*zj
2420 if (rij.lt.r0ijsq) then
2421 evdw1ij=0.25d0*(rij-r0ijsq)**2
2429 ! Calculate contributions to the Cartesian gradient.
2435 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2436 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2439 ! Loop over residues i+1 thru j-1.
2443 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2448 !grad do i=nnt,nct-1
2450 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2452 !grad do j=i+1,nct-1
2454 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
2459 end subroutine eelec_soft_sphere
2460 !-----------------------------------------------------------------------------
2461 subroutine vec_and_deriv
2462 ! implicit real*8 (a-h,o-z)
2463 ! include 'DIMENSIONS'
2467 ! include 'COMMON.IOUNITS'
2468 ! include 'COMMON.GEO'
2469 ! include 'COMMON.VAR'
2470 ! include 'COMMON.LOCAL'
2471 ! include 'COMMON.CHAIN'
2472 ! include 'COMMON.VECTORS'
2473 ! include 'COMMON.SETUP'
2474 ! include 'COMMON.TIME1'
2475 real(kind=8),dimension(3,3,2) :: uyder,uzder
2476 real(kind=8),dimension(2) :: vbld_inv_temp
2477 ! Compute the local reference systems. For reference system (i), the
2478 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
2479 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2482 real(kind=8) :: facy,fac,costh
2485 do i=ivec_start,ivec_end
2489 if (i.eq.nres-1) then
2490 ! Case of the last full residue
2491 ! Compute the Z-axis
2492 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2493 costh=dcos(pi-theta(nres))
2494 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2498 ! Compute the derivatives of uz
2500 uzder(2,1,1)=-dc_norm(3,i-1)
2501 uzder(3,1,1)= dc_norm(2,i-1)
2502 uzder(1,2,1)= dc_norm(3,i-1)
2504 uzder(3,2,1)=-dc_norm(1,i-1)
2505 uzder(1,3,1)=-dc_norm(2,i-1)
2506 uzder(2,3,1)= dc_norm(1,i-1)
2509 uzder(2,1,2)= dc_norm(3,i)
2510 uzder(3,1,2)=-dc_norm(2,i)
2511 uzder(1,2,2)=-dc_norm(3,i)
2513 uzder(3,2,2)= dc_norm(1,i)
2514 uzder(1,3,2)= dc_norm(2,i)
2515 uzder(2,3,2)=-dc_norm(1,i)
2517 ! Compute the Y-axis
2520 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2522 ! Compute the derivatives of uy
2525 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2526 -dc_norm(k,i)*dc_norm(j,i-1)
2527 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2529 uyder(j,j,1)=uyder(j,j,1)-costh
2530 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2535 uygrad(l,k,j,i)=uyder(l,k,j)
2536 uzgrad(l,k,j,i)=uzder(l,k,j)
2540 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2541 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2542 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2543 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2546 ! Compute the Z-axis
2547 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2548 costh=dcos(pi-theta(i+2))
2549 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2553 ! Compute the derivatives of uz
2555 uzder(2,1,1)=-dc_norm(3,i+1)
2556 uzder(3,1,1)= dc_norm(2,i+1)
2557 uzder(1,2,1)= dc_norm(3,i+1)
2559 uzder(3,2,1)=-dc_norm(1,i+1)
2560 uzder(1,3,1)=-dc_norm(2,i+1)
2561 uzder(2,3,1)= dc_norm(1,i+1)
2564 uzder(2,1,2)= dc_norm(3,i)
2565 uzder(3,1,2)=-dc_norm(2,i)
2566 uzder(1,2,2)=-dc_norm(3,i)
2568 uzder(3,2,2)= dc_norm(1,i)
2569 uzder(1,3,2)= dc_norm(2,i)
2570 uzder(2,3,2)=-dc_norm(1,i)
2572 ! Compute the Y-axis
2575 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2577 ! Compute the derivatives of uy
2580 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2581 -dc_norm(k,i)*dc_norm(j,i+1)
2582 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2584 uyder(j,j,1)=uyder(j,j,1)-costh
2585 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2590 uygrad(l,k,j,i)=uyder(l,k,j)
2591 uzgrad(l,k,j,i)=uzder(l,k,j)
2595 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2596 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2597 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2598 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2602 vbld_inv_temp(1)=vbld_inv(i+1)
2603 if (i.lt.nres-1) then
2604 vbld_inv_temp(2)=vbld_inv(i+2)
2606 vbld_inv_temp(2)=vbld_inv(i)
2611 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2612 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2617 #if defined(PARVEC) && defined(MPI)
2618 if (nfgtasks1.gt.1) then
2620 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2621 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2622 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2623 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2624 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2626 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2627 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2629 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2630 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2631 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2632 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2633 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2634 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2635 time_gather=time_gather+MPI_Wtime()-time00
2637 ! if (fg_rank.eq.0) then
2638 ! write (iout,*) "Arrays UY and UZ"
2640 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2646 end subroutine vec_and_deriv
2647 !-----------------------------------------------------------------------------
2648 subroutine check_vecgrad
2649 ! implicit real*8 (a-h,o-z)
2650 ! include 'DIMENSIONS'
2651 ! include 'COMMON.IOUNITS'
2652 ! include 'COMMON.GEO'
2653 ! include 'COMMON.VAR'
2654 ! include 'COMMON.LOCAL'
2655 ! include 'COMMON.CHAIN'
2656 ! include 'COMMON.VECTORS'
2657 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2658 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2659 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2660 real(kind=8),dimension(3) :: erij
2661 real(kind=8) :: delta=1.0d-7
2667 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2668 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2669 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2670 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2671 !d & (dc_norm(if90,i),if90=1,3)
2672 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2673 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2674 !d write(iout,'(a)')
2680 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2681 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2694 !d write (iout,*) 'i=',i
2696 erij(k)=dc_norm(k,i)
2700 dc_norm(k,i)=erij(k)
2702 dc_norm(j,i)=dc_norm(j,i)+delta
2703 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2705 ! dc_norm(k,i)=dc_norm(k,i)/fac
2707 ! write (iout,*) (dc_norm(k,i),k=1,3)
2708 ! write (iout,*) (erij(k),k=1,3)
2711 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2712 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2713 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2714 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2716 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2717 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2718 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2721 dc_norm(k,i)=erij(k)
2724 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2725 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2726 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2727 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2728 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2729 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2730 !d write (iout,'(a)')
2734 end subroutine check_vecgrad
2735 !-----------------------------------------------------------------------------
2736 subroutine set_matrices
2737 ! implicit real*8 (a-h,o-z)
2738 ! include 'DIMENSIONS'
2741 ! include "COMMON.SETUP"
2743 integer :: status(MPI_STATUS_SIZE)
2745 ! include 'COMMON.IOUNITS'
2746 ! include 'COMMON.GEO'
2747 ! include 'COMMON.VAR'
2748 ! include 'COMMON.LOCAL'
2749 ! include 'COMMON.CHAIN'
2750 ! include 'COMMON.DERIV'
2751 ! include 'COMMON.INTERACT'
2752 ! include 'COMMON.CONTACTS'
2753 ! include 'COMMON.TORSION'
2754 ! include 'COMMON.VECTORS'
2755 ! include 'COMMON.FFIELD'
2756 real(kind=8) :: auxvec(2),auxmat(2,2)
2757 integer :: i,iti1,iti,k,l
2758 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2,cost1,sint1,&
2759 sint1sq,sint1cub,sint1cost1,b1k,b2k,aux
2760 ! print *,"in set matrices"
2762 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2763 ! to calculate the el-loc multibody terms of various order.
2768 do i=ivec_start+2,ivec_end+2
2772 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2773 if (itype(i-2,1).eq.0) then
2776 iti = itype2loc(itype(i-2,1))
2781 !c 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 iti1 = itype2loc(itype(i-1,1))
2787 ! print *,i,itype(i-2,1),iti
2789 cost1=dcos(theta(i-1))
2790 sint1=dsin(theta(i-1))
2792 sint1cub=sint1sq*sint1
2793 sint1cost1=2*sint1*cost1
2794 ! print *,"cost1",cost1,theta(i-1)
2795 !c write (iout,*) "bnew1",i,iti
2796 !c write (iout,*) (bnew1(k,1,iti),k=1,3)
2797 !c write (iout,*) (bnew1(k,2,iti),k=1,3)
2798 !c write (iout,*) "bnew2",i,iti
2799 !c write (iout,*) (bnew2(k,1,iti),k=1,3)
2800 !c write (iout,*) (bnew2(k,2,iti),k=1,3)
2802 ! print *,bnew1(1,k,iti),"bnew1"
2804 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
2806 ! write(*,*) shape(b1)
2807 ! if(.not.allocated(b1)) print *, "WTF?"
2812 gtb1(k,i-2)=cost1*b1k-sint1sq*&
2813 (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
2814 ! print *,gtb1(k,i-2)
2816 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
2820 gtb2(k,i-2)=cost1*b2k-sint1sq*&
2821 (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
2822 ! print *,gtb2(k,i-2)
2827 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
2828 cc(1,k,i-2)=sint1sq*aux
2829 gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*&
2830 (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
2831 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
2832 dd(1,k,i-2)=sint1sq*aux
2833 gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*&
2834 (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
2836 ! print *,"after cc"
2837 cc(2,1,i-2)=cc(1,2,i-2)
2838 cc(2,2,i-2)=-cc(1,1,i-2)
2839 gtcc(2,1,i-2)=gtcc(1,2,i-2)
2840 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
2841 dd(2,1,i-2)=dd(1,2,i-2)
2842 dd(2,2,i-2)=-dd(1,1,i-2)
2843 gtdd(2,1,i-2)=gtdd(1,2,i-2)
2844 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
2845 ! print *,"after dd"
2849 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
2850 EE(l,k,i-2)=sint1sq*aux
2851 gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
2854 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
2855 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
2856 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
2857 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
2858 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
2859 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
2860 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
2861 ! print *,"after ee"
2863 !c b1tilde(1,i-2)=b1(1,i-2)
2864 !c b1tilde(2,i-2)=-b1(2,i-2)
2865 !c b2tilde(1,i-2)=b2(1,i-2)
2866 !c b2tilde(2,i-2)=-b2(2,i-2)
2868 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2869 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
2870 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
2871 write (iout,*) 'theta=', theta(i-1)
2874 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2875 ! write(iout,*) "i,",molnum(i),nloctyp
2876 ! print *, "i,",molnum(i),i,itype(i-2,1)
2877 if (molnum(i).eq.1) then
2878 if (itype(i-2,1).eq.ntyp1) then
2881 iti = itype2loc(itype(i-2,1))
2889 !c write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti
2890 !c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2891 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2892 iti1 = itype2loc(itype(i-1,1))
2903 CC(k,l,i-2)=ccold(k,l,iti)
2904 DD(k,l,i-2)=ddold(k,l,iti)
2905 EE(k,l,i-2)=eeold(k,l,iti)
2909 b1tilde(1,i-2)= b1(1,i-2)
2910 b1tilde(2,i-2)=-b1(2,i-2)
2911 b2tilde(1,i-2)= b2(1,i-2)
2912 b2tilde(2,i-2)=-b2(2,i-2)
2914 Ctilde(1,1,i-2)= CC(1,1,i-2)
2915 Ctilde(1,2,i-2)= CC(1,2,i-2)
2916 Ctilde(2,1,i-2)=-CC(2,1,i-2)
2917 Ctilde(2,2,i-2)=-CC(2,2,i-2)
2919 Dtilde(1,1,i-2)= DD(1,1,i-2)
2920 Dtilde(1,2,i-2)= DD(1,2,i-2)
2921 Dtilde(2,1,i-2)=-DD(2,1,i-2)
2922 Dtilde(2,2,i-2)=-DD(2,2,i-2)
2925 do i=ivec_start+2,ivec_end+2
2931 if (i .lt. nres+1) then
2968 if (i .gt. 3 .and. i .lt. nres+1) then
2969 obrot_der(1,i-2)=-sin1
2970 obrot_der(2,i-2)= cos1
2971 Ugder(1,1,i-2)= sin1
2972 Ugder(1,2,i-2)=-cos1
2973 Ugder(2,1,i-2)=-cos1
2974 Ugder(2,2,i-2)=-sin1
2977 obrot2_der(1,i-2)=-dwasin2
2978 obrot2_der(2,i-2)= dwacos2
2979 Ug2der(1,1,i-2)= dwasin2
2980 Ug2der(1,2,i-2)=-dwacos2
2981 Ug2der(2,1,i-2)=-dwacos2
2982 Ug2der(2,2,i-2)=-dwasin2
2984 obrot_der(1,i-2)=0.0d0
2985 obrot_der(2,i-2)=0.0d0
2986 Ugder(1,1,i-2)=0.0d0
2987 Ugder(1,2,i-2)=0.0d0
2988 Ugder(2,1,i-2)=0.0d0
2989 Ugder(2,2,i-2)=0.0d0
2990 obrot2_der(1,i-2)=0.0d0
2991 obrot2_der(2,i-2)=0.0d0
2992 Ug2der(1,1,i-2)=0.0d0
2993 Ug2der(1,2,i-2)=0.0d0
2994 Ug2der(2,1,i-2)=0.0d0
2995 Ug2der(2,2,i-2)=0.0d0
2997 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2998 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2999 if (itype(i-2,1).eq.0) then
3002 iti = itype2loc(itype(i-2,1))
3007 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3008 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3009 if (itype(i-1,1).eq.0) then
3012 iti1 = itype2loc(itype(i-1,1))
3017 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
3018 !d write (iout,*) '*******i',i,' iti1',iti
3019 ! write (iout,*) 'b1',b1(:,iti)
3020 ! write (iout,*) 'b2',b2(:,i-2)
3021 !d write (iout,*) 'Ug',Ug(:,:,i-2)
3022 ! if (i .gt. iatel_s+2) then
3023 if (i .gt. nnt+2) then
3024 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
3026 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
3027 !c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
3030 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
3031 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
3032 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
3034 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
3035 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
3036 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3037 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
3038 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
3049 DtUg2(l,k,i-2)=0.0d0
3053 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
3054 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
3056 muder(k,i-2)=Ub2der(k,i-2)
3058 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3059 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3060 if (itype(i-1,1).eq.0) then
3062 elseif (itype(i-1,1).le.ntyp) then
3063 iti1 = itype2loc(itype(i-1,1))
3071 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3073 if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
3074 if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,i-1)
3075 if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
3076 !d write (iout,*) 'mu1',mu1(:,i-2)
3077 !d write (iout,*) 'mu2',mu2(:,i-2)
3078 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
3080 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3081 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
3082 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3083 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
3084 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3085 ! Vectors and matrices dependent on a single virtual-bond dihedral.
3086 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
3087 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3088 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3089 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
3090 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
3091 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3092 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3093 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3094 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3097 ! Matrices dependent on two consecutive virtual-bond dihedrals.
3098 ! The order of matrices is from left to right.
3099 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
3101 ! do i=max0(ivec_start,2),ivec_end
3103 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3104 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3105 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3106 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3107 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3108 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3109 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3110 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3113 #if defined(MPI) && defined(PARMAT)
3115 ! if (fg_rank.eq.0) then
3116 write (iout,*) "Arrays UG and UGDER before GATHER"
3118 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3119 ((ug(l,k,i),l=1,2),k=1,2),&
3120 ((ugder(l,k,i),l=1,2),k=1,2)
3122 write (iout,*) "Arrays UG2 and UG2DER"
3124 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3125 ((ug2(l,k,i),l=1,2),k=1,2),&
3126 ((ug2der(l,k,i),l=1,2),k=1,2)
3128 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3130 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3131 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
3132 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3134 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3136 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3137 costab(i),sintab(i),costab2(i),sintab2(i)
3139 write (iout,*) "Array MUDER"
3141 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3145 if (nfgtasks.gt.1) then
3147 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3148 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3149 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3151 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
3152 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3154 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
3155 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3157 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
3158 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3160 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
3161 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3163 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
3164 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3166 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
3167 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3169 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
3170 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
3171 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3172 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
3173 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
3174 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3175 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
3176 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
3177 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3178 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
3179 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
3180 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3181 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
3183 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
3184 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3186 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
3187 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3189 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
3190 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3192 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
3193 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3195 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
3196 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3198 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
3199 ivec_count(fg_rank1),&
3200 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3202 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
3203 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3205 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
3206 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3208 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
3209 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3211 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
3212 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3214 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
3215 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3217 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
3218 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3220 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
3221 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3223 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
3224 ivec_count(fg_rank1),&
3225 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3227 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
3228 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3230 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
3231 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3233 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
3234 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3236 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
3237 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3239 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
3240 ivec_count(fg_rank1),&
3241 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3243 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
3244 ivec_count(fg_rank1),&
3245 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3247 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
3248 ivec_count(fg_rank1),&
3249 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
3250 MPI_MAT2,FG_COMM1,IERR)
3251 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
3252 ivec_count(fg_rank1),&
3253 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
3254 MPI_MAT2,FG_COMM1,IERR)
3257 ! Passes matrix info through the ring
3260 if (irecv.lt.0) irecv=nfgtasks1-1
3263 if (inext.ge.nfgtasks1) inext=0
3265 ! write (iout,*) "isend",isend," irecv",irecv
3267 lensend=lentyp(isend)
3268 lenrecv=lentyp(irecv)
3269 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
3270 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3271 ! & MPI_ROTAT1(lensend),inext,2200+isend,
3272 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3273 ! & iprev,2200+irecv,FG_COMM,status,IERR)
3274 ! write (iout,*) "Gather ROTAT1"
3276 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3277 ! & MPI_ROTAT2(lensend),inext,3300+isend,
3278 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3279 ! & iprev,3300+irecv,FG_COMM,status,IERR)
3280 ! write (iout,*) "Gather ROTAT2"
3282 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
3283 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
3284 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
3285 iprev,4400+irecv,FG_COMM,status,IERR)
3286 ! write (iout,*) "Gather ROTAT_OLD"
3288 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
3289 MPI_PRECOMP11(lensend),inext,5500+isend,&
3290 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
3291 iprev,5500+irecv,FG_COMM,status,IERR)
3292 ! write (iout,*) "Gather PRECOMP11"
3294 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
3295 MPI_PRECOMP12(lensend),inext,6600+isend,&
3296 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
3297 iprev,6600+irecv,FG_COMM,status,IERR)
3298 ! write (iout,*) "Gather PRECOMP12"
3300 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
3302 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
3303 MPI_ROTAT2(lensend),inext,7700+isend,&
3304 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
3305 iprev,7700+irecv,FG_COMM,status,IERR)
3306 ! write (iout,*) "Gather PRECOMP21"
3308 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
3309 MPI_PRECOMP22(lensend),inext,8800+isend,&
3310 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
3311 iprev,8800+irecv,FG_COMM,status,IERR)
3312 ! write (iout,*) "Gather PRECOMP22"
3314 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
3315 MPI_PRECOMP23(lensend),inext,9900+isend,&
3316 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
3317 MPI_PRECOMP23(lenrecv),&
3318 iprev,9900+irecv,FG_COMM,status,IERR)
3319 ! write (iout,*) "Gather PRECOMP23"
3324 if (irecv.lt.0) irecv=nfgtasks1-1
3327 time_gather=time_gather+MPI_Wtime()-time00
3330 ! if (fg_rank.eq.0) then
3331 write (iout,*) "Arrays UG and UGDER"
3333 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3334 ((ug(l,k,i),l=1,2),k=1,2),&
3335 ((ugder(l,k,i),l=1,2),k=1,2)
3337 write (iout,*) "Arrays UG2 and UG2DER"
3339 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3340 ((ug2(l,k,i),l=1,2),k=1,2),&
3341 ((ug2der(l,k,i),l=1,2),k=1,2)
3343 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3345 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3346 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
3347 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3349 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3351 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3352 costab(i),sintab(i),costab2(i),sintab2(i)
3354 write (iout,*) "Array MUDER"
3356 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3362 !d iti = itortyp(itype(i,1))
3365 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3366 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3370 end subroutine set_matrices
3371 !-----------------------------------------------------------------------------
3372 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3374 ! This subroutine calculates the average interaction energy and its gradient
3375 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
3376 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3377 ! The potential depends both on the distance of peptide-group centers and on
3378 ! the orientation of the CA-CA virtual bonds.
3381 ! implicit real*8 (a-h,o-z)
3385 ! include 'DIMENSIONS'
3386 ! include 'COMMON.CONTROL'
3387 ! include 'COMMON.SETUP'
3388 ! include 'COMMON.IOUNITS'
3389 ! include 'COMMON.GEO'
3390 ! include 'COMMON.VAR'
3391 ! include 'COMMON.LOCAL'
3392 ! include 'COMMON.CHAIN'
3393 ! include 'COMMON.DERIV'
3394 ! include 'COMMON.INTERACT'
3395 ! include 'COMMON.CONTACTS'
3396 ! include 'COMMON.TORSION'
3397 ! include 'COMMON.VECTORS'
3398 ! include 'COMMON.FFIELD'
3399 ! include 'COMMON.TIME1'
3400 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
3401 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3402 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3403 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3404 real(kind=8),dimension(4) :: muij
3405 !el integer :: num_conti,j1,j2
3406 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3407 !el dz_normi,xmedi,ymedi,zmedi
3409 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3410 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3413 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3415 real(kind=8) :: scal_el=1.0d0
3417 real(kind=8) :: scal_el=0.5d0
3420 ! 13-go grudnia roku pamietnego...
3421 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3423 0.0d0,0.0d0,1.0d0/),shape(unmat))
3425 integer :: i,k,j,icont
3426 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
3427 real(kind=8) :: fac,t_eelecij,fracinbuf
3430 !d write(iout,*) 'In EELEC'
3431 ! print *,"IN EELEC"
3433 !d write(iout,*) 'Type',i
3434 !d write(iout,*) 'B1',B1(:,i)
3435 !d write(iout,*) 'B2',B2(:,i)
3436 !d write(iout,*) 'CC',CC(:,:,i)
3437 !d write(iout,*) 'DD',DD(:,:,i)
3438 !d write(iout,*) 'EE',EE(:,:,i)
3440 !d call check_vecgrad
3453 if (nres_molec(1).eq.0) return
3456 if (icheckgrad.eq.1) then
3459 ! dc_norm(1,i)=0.0d0
3460 ! dc_norm(2,i)=0.0d0
3461 ! dc_norm(3,i)=0.0d0
3464 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3466 dc_norm(k,i)=dc(k,i)*fac
3468 ! write (iout,*) 'i',i,' fac',fac
3471 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
3473 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3474 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
3475 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3476 ! call vec_and_deriv
3480 ! print *, "before set matrices"
3482 ! print *, "after set matrices"
3485 time_mat=time_mat+MPI_Wtime()-time01
3488 ! print *, "after set matrices"
3490 !d write (iout,*) 'i=',i
3492 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3495 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3496 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3509 !d print '(a)','Enter EELEC'
3510 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3511 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
3512 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
3514 gel_loc_loc(i)=0.0d0
3519 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3521 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
3525 ! print *,"before iturn3 loop"
3526 do i=iturn3_start,iturn3_end
3527 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3528 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
3532 dx_normi=dc_norm(1,i)
3533 dy_normi=dc_norm(2,i)
3534 dz_normi=dc_norm(3,i)
3535 xmedi=c(1,i)+0.5d0*dxi
3536 ymedi=c(2,i)+0.5d0*dyi
3537 zmedi=c(3,i)+0.5d0*dzi
3538 call to_box(xmedi,ymedi,zmedi)
3539 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
3541 call eelecij(i,i+2,ees,evdw1,eel_loc)
3542 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3543 num_cont_hb(i)=num_conti
3545 do i=iturn4_start,iturn4_end
3546 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3547 .or. itype(i+3,1).eq.ntyp1 &
3548 .or. itype(i+4,1).eq.ntyp1) cycle
3549 ! print *,"before2",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
3553 dx_normi=dc_norm(1,i)
3554 dy_normi=dc_norm(2,i)
3555 dz_normi=dc_norm(3,i)
3556 xmedi=c(1,i)+0.5d0*dxi
3557 ymedi=c(2,i)+0.5d0*dyi
3558 zmedi=c(3,i)+0.5d0*dzi
3559 call to_box(xmedi,ymedi,zmedi)
3560 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
3561 num_conti=num_cont_hb(i)
3562 call eelecij(i,i+3,ees,evdw1,eel_loc)
3563 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
3564 call eturn4(i,eello_turn4)
3565 ! print *,"before",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
3566 num_cont_hb(i)=num_conti
3569 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3571 ! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
3572 ! do i=iatel_s,iatel_e
3574 do icont=g_listpp_start,g_listpp_end
3575 i=newcontlistppi(icont)
3576 j=newcontlistppj(icont)
3577 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
3581 dx_normi=dc_norm(1,i)
3582 dy_normi=dc_norm(2,i)
3583 dz_normi=dc_norm(3,i)
3584 xmedi=c(1,i)+0.5d0*dxi
3585 ymedi=c(2,i)+0.5d0*dyi
3586 zmedi=c(3,i)+0.5d0*dzi
3587 call to_box(xmedi,ymedi,zmedi)
3588 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
3590 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3591 num_conti=num_cont_hb(i)
3592 ! do j=ielstart(i),ielend(i)
3593 ! write (iout,*) i,j,itype(i,1),itype(j,1)
3594 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
3595 call eelecij(i,j,ees,evdw1,eel_loc)
3597 num_cont_hb(i)=num_conti
3599 ! write (iout,*) "Number of loop steps in EELEC:",ind
3601 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3602 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3604 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3605 !cc eel_loc=eel_loc+eello_turn3
3606 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3608 end subroutine eelec
3609 !-----------------------------------------------------------------------------
3610 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3613 ! implicit real*8 (a-h,o-z)
3614 ! include 'DIMENSIONS'
3618 ! include 'COMMON.CONTROL'
3619 ! include 'COMMON.IOUNITS'
3620 ! include 'COMMON.GEO'
3621 ! include 'COMMON.VAR'
3622 ! include 'COMMON.LOCAL'
3623 ! include 'COMMON.CHAIN'
3624 ! include 'COMMON.DERIV'
3625 ! include 'COMMON.INTERACT'
3626 ! include 'COMMON.CONTACTS'
3627 ! include 'COMMON.TORSION'
3628 ! include 'COMMON.VECTORS'
3629 ! include 'COMMON.FFIELD'
3630 ! include 'COMMON.TIME1'
3631 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3632 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3633 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3634 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3635 real(kind=8),dimension(4) :: muij
3636 real(kind=8) :: geel_loc_ij,geel_loc_ji
3637 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3638 dist_temp, dist_init,rlocshield,fracinbuf
3639 integer xshift,yshift,zshift,ilist,iresshield
3640 !el integer :: num_conti,j1,j2
3641 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3642 !el dz_normi,xmedi,ymedi,zmedi
3644 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3645 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3648 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3650 real(kind=8) :: scal_el=1.0d0
3652 real(kind=8) :: scal_el=0.5d0
3655 ! 13-go grudnia roku pamietnego...
3656 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3658 0.0d0,0.0d0,1.0d0/),shape(unmat))
3659 ! integer :: maxconts=nres/4
3661 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3662 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3663 real(kind=8) :: faclipij2, faclipij
3664 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3665 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3666 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3667 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3668 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3669 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3670 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3671 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3672 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3674 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3675 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3677 ! time00=MPI_Wtime()
3678 !d write (iout,*) "eelecij",i,j
3682 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3683 aaa=app(iteli,itelj)
3684 bbb=bpp(iteli,itelj)
3685 ael6i=ael6(iteli,itelj)
3686 ael3i=ael3(iteli,itelj)
3690 dx_normj=dc_norm(1,j)
3691 dy_normj=dc_norm(2,j)
3692 dz_normj=dc_norm(3,j)
3693 ! xj=c(1,j)+0.5D0*dxj-xmedi
3694 ! yj=c(2,j)+0.5D0*dyj-ymedi
3695 ! zj=c(3,j)+0.5D0*dzj-zmedi
3700 call to_box(xj,yj,zj)
3701 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
3702 faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
3703 faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3704 xj=boxshift(xj-xmedi,boxxsize)
3705 yj=boxshift(yj-ymedi,boxysize)
3706 zj=boxshift(zj-zmedi,boxzsize)
3708 rij=xj*xj+yj*yj+zj*zj
3711 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3712 sss_ele_cut=sscale_ele(rij)
3713 sss_ele_grad=sscagrad_ele(rij)
3715 ! sss_ele_grad=0.0d0
3716 ! print *,sss_ele_cut,sss_ele_grad,&
3717 ! (rij),r_cut_ele,rlamb_ele
3718 if (sss_ele_cut.le.0.0) go to 128
3723 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3724 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3725 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3726 fac=cosa-3.0D0*cosb*cosg
3728 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3729 if (j.eq.i+2) ev1=scal_el*ev1
3734 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3737 if (shield_mode.gt.0) then
3738 !C fac_shield(i)=0.4
3739 !C fac_shield(j)=0.6
3740 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3741 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3743 ees=ees+eesij*sss_ele_cut
3744 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3745 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3751 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3752 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3755 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3756 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3757 ! ees=ees+eesij*sss_ele_cut
3758 evdw1=evdw1+evdwij*sss_ele_cut &
3759 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3760 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3761 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3762 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3763 !d & xmedi,ymedi,zmedi,xj,yj,zj
3765 if (energy_dec) then
3766 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3767 ! 'evdw1',i,j,evdwij,&
3768 ! iteli,itelj,aaa,evdw1
3769 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3770 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3773 ! Calculate contributions to the Cartesian gradient.
3776 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3777 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3778 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3779 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3785 ! Radial derivatives. First process both termini of the fragment (i,j)
3787 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3788 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3789 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3790 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3791 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3792 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3794 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3795 (shield_mode.gt.0)) then
3797 do ilist=1,ishield_list(i)
3798 iresshield=shield_list(ilist,i)
3800 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3802 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3804 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3806 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3809 do ilist=1,ishield_list(j)
3810 iresshield=shield_list(ilist,j)
3812 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3814 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3816 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3818 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3822 gshieldc(k,i)=gshieldc(k,i)+ &
3823 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3826 gshieldc(k,j)=gshieldc(k,j)+ &
3827 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3830 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3831 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3834 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3835 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3843 ! ghalf=0.5D0*ggg(k)
3844 ! gelc(k,i)=gelc(k,i)+ghalf
3845 ! gelc(k,j)=gelc(k,j)+ghalf
3847 ! 9/28/08 AL Gradient compotents will be summed only at the end
3849 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3850 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3852 gelc_long(3,j)=gelc_long(3,j)+ &
3853 ssgradlipj*eesij/2.0d0*lipscale**2&
3856 gelc_long(3,i)=gelc_long(3,i)+ &
3857 ssgradlipi*eesij/2.0d0*lipscale**2&
3862 ! Loop over residues i+1 thru j-1.
3866 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3869 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3870 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3871 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3872 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3873 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3874 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3877 ! ghalf=0.5D0*ggg(k)
3878 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3879 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3881 ! 9/28/08 AL Gradient compotents will be summed only at the end
3883 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3884 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3887 !C Lipidic part for scaling weight
3888 gvdwpp(3,j)=gvdwpp(3,j)+ &
3889 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3890 gvdwpp(3,i)=gvdwpp(3,i)+ &
3891 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3892 !! Loop over residues i+1 thru j-1.
3896 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3900 facvdw=(ev1+evdwij)*sss_ele_cut &
3901 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3903 facel=(el1+eesij)*sss_ele_cut
3905 fac=-3*rrmij*(facvdw+facvdw+facel)
3910 ! Radial derivatives. First process both termini of the fragment (i,j)
3912 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3913 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3914 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3916 ! ghalf=0.5D0*ggg(k)
3917 ! gelc(k,i)=gelc(k,i)+ghalf
3918 ! gelc(k,j)=gelc(k,j)+ghalf
3920 ! 9/28/08 AL Gradient compotents will be summed only at the end
3922 gelc_long(k,j)=gelc(k,j)+ggg(k)
3923 gelc_long(k,i)=gelc(k,i)-ggg(k)
3926 ! Loop over residues i+1 thru j-1.
3930 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3933 ! 9/28/08 AL Gradient compotents will be summed only at the end
3934 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3935 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3936 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3937 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3938 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3939 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3942 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3943 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3945 gvdwpp(3,j)=gvdwpp(3,j)+ &
3946 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3947 gvdwpp(3,i)=gvdwpp(3,i)+ &
3948 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3954 ecosa=2.0D0*fac3*fac1+fac4
3957 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3958 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3960 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3961 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3963 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3964 !d & (dcosg(k),k=1,3)
3966 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3967 *fac_shield(i)**2*fac_shield(j)**2 &
3968 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3972 ! ghalf=0.5D0*ggg(k)
3973 ! gelc(k,i)=gelc(k,i)+ghalf
3974 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3975 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3976 ! gelc(k,j)=gelc(k,j)+ghalf
3977 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3978 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3982 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3986 gelc(k,i)=gelc(k,i) &
3987 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3988 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3990 *fac_shield(i)**2*fac_shield(j)**2 &
3991 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3993 gelc(k,j)=gelc(k,j) &
3994 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3995 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3997 *fac_shield(i)**2*fac_shield(j)**2 &
3998 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4000 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4001 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4004 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
4005 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
4006 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4008 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4009 ! energy of a peptide unit is assumed in the form of a second-order
4010 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4011 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4012 ! are computed for EVERY pair of non-contiguous peptide groups.
4014 if (j.lt.nres-1) then
4025 muij(kkk)=mu(k,i)*mu(l,j)
4027 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4028 !c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4029 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4030 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4031 !c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4032 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4037 !d write (iout,*) 'EELEC: i',i,' j',j
4038 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
4039 !d write(iout,*) 'muij',muij
4040 ury=scalar(uy(1,i),erij)
4041 urz=scalar(uz(1,i),erij)
4042 vry=scalar(uy(1,j),erij)
4043 vrz=scalar(uz(1,j),erij)
4044 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4045 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4046 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4047 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4048 fac=dsqrt(-ael6i)*r3ij
4053 !d write (iout,'(4i5,4f10.5)')
4054 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
4055 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4056 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4057 !d & uy(:,j),uz(:,j)
4058 !d write (iout,'(4f10.5)')
4059 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4060 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4061 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
4062 !d write (iout,'(9f10.5/)')
4063 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4064 ! Derivatives of the elements of A in virtual-bond vectors
4065 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4067 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4068 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4069 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4070 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4071 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4072 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4073 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4074 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4075 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4076 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4077 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4078 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4080 ! Compute radial contributions to the gradient
4098 ! Add the contributions coming from er
4101 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4102 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4103 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4104 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4107 ! Derivatives in DC(i)
4108 !grad ghalf1=0.5d0*agg(k,1)
4109 !grad ghalf2=0.5d0*agg(k,2)
4110 !grad ghalf3=0.5d0*agg(k,3)
4111 !grad ghalf4=0.5d0*agg(k,4)
4112 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
4113 -3.0d0*uryg(k,2)*vry)!+ghalf1
4114 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
4115 -3.0d0*uryg(k,2)*vrz)!+ghalf2
4116 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
4117 -3.0d0*urzg(k,2)*vry)!+ghalf3
4118 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
4119 -3.0d0*urzg(k,2)*vrz)!+ghalf4
4120 ! Derivatives in DC(i+1)
4121 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
4122 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4123 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
4124 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4125 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
4126 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4127 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
4128 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4129 ! Derivatives in DC(j)
4130 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
4131 -3.0d0*vryg(k,2)*ury)!+ghalf1
4132 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
4133 -3.0d0*vrzg(k,2)*ury)!+ghalf2
4134 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
4135 -3.0d0*vryg(k,2)*urz)!+ghalf3
4136 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
4137 -3.0d0*vrzg(k,2)*urz)!+ghalf4
4138 ! Derivatives in DC(j+1) or DC(nres-1)
4139 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
4140 -3.0d0*vryg(k,3)*ury)
4141 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
4142 -3.0d0*vrzg(k,3)*ury)
4143 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
4144 -3.0d0*vryg(k,3)*urz)
4145 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
4146 -3.0d0*vrzg(k,3)*urz)
4147 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
4149 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4162 aggi(k,l)=-aggi(k,l)
4163 aggi1(k,l)=-aggi1(k,l)
4164 aggj(k,l)=-aggj(k,l)
4165 aggj1(k,l)=-aggj1(k,l)
4168 if (j.lt.nres-1) then
4174 aggi(k,l)=-aggi(k,l)
4175 aggi1(k,l)=-aggi1(k,l)
4176 aggj(k,l)=-aggj(k,l)
4177 aggj1(k,l)=-aggj1(k,l)
4188 aggi(k,l)=-aggi(k,l)
4189 aggi1(k,l)=-aggi1(k,l)
4190 aggj(k,l)=-aggj(k,l)
4191 aggj1(k,l)=-aggj1(k,l)
4196 IF (wel_loc.gt.0.0d0) THEN
4197 ! Contribution to the local-electrostatic energy coming from the i-j pair
4198 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
4200 if (shield_mode.eq.0) then
4204 eel_loc_ij=eel_loc_ij &
4205 *fac_shield(i)*fac_shield(j) &
4206 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4207 !C Now derivative over eel_loc
4208 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4209 (shield_mode.gt.0)) then
4212 do ilist=1,ishield_list(i)
4213 iresshield=shield_list(ilist,i)
4215 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
4218 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
4220 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
4223 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
4227 do ilist=1,ishield_list(j)
4228 iresshield=shield_list(ilist,j)
4230 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
4233 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
4235 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
4238 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
4245 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
4246 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
4248 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
4249 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
4251 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
4252 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
4254 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
4255 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
4262 geel_loc_ij=(a22*gmuij1(1)&
4266 *fac_shield(i)*fac_shield(j)&
4268 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4271 !c write(iout,*) "derivative over thatai"
4272 !c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4274 gloc(nphi+i,icg)=gloc(nphi+i,icg)+&
4276 !c write(iout,*) "derivative over thatai-1"
4277 !c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4284 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+&
4285 geel_loc_ij*wel_loc&
4286 *fac_shield(i)*fac_shield(j)&
4288 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4291 !c Derivative over j residue
4292 geel_loc_ji=a22*gmuji1(1)&
4296 !c write(iout,*) "derivative over thataj"
4297 !c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4300 gloc(nphi+j,icg)=gloc(nphi+j,icg)+&
4301 geel_loc_ji*wel_loc&
4302 *fac_shield(i)*fac_shield(j)&
4304 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4312 !c write(iout,*) "derivative over thataj-1"
4313 !c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4315 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+&
4316 geel_loc_ji*wel_loc&
4317 *fac_shield(i)*fac_shield(j)&
4319 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4323 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4325 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4326 ! 'eelloc',i,j,eel_loc_ij
4327 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,8f8.3)') &
4328 'eelloc',i,j,eel_loc_ij,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4329 ! print *,"EELLOC",i,gel_loc_loc(i-1)
4331 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
4332 ! if (energy_dec) write (iout,*) "muij",muij
4333 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
4335 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
4336 ! Partial derivatives in virtual-bond dihedral angles gamma
4338 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
4339 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
4340 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
4342 *fac_shield(i)*fac_shield(j) &
4343 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4345 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
4346 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
4347 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
4349 *fac_shield(i)*fac_shield(j) &
4350 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4351 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4353 ! ggg(1)=(agg(1,1)*muij(1)+ &
4354 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
4356 ! +eel_loc_ij*sss_ele_grad*rmij*xj
4357 ! ggg(2)=(agg(2,1)*muij(1)+ &
4358 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
4360 ! +eel_loc_ij*sss_ele_grad*rmij*yj
4361 ! ggg(3)=(agg(3,1)*muij(1)+ &
4362 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
4364 ! +eel_loc_ij*sss_ele_grad*rmij*zj
4370 ggg(l)=(agg(l,1)*muij(1)+ &
4371 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
4373 *fac_shield(i)*fac_shield(j) &
4374 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
4375 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4378 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4379 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4380 !grad ghalf=0.5d0*ggg(l)
4381 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
4382 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
4384 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
4385 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
4386 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4388 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
4389 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
4390 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4394 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4397 ! Remaining derivatives of eello
4399 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
4400 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
4402 *fac_shield(i)*fac_shield(j) &
4403 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4405 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4406 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
4407 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
4408 +aggi1(l,4)*muij(4))&
4410 *fac_shield(i)*fac_shield(j) &
4411 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4413 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4414 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
4415 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
4417 *fac_shield(i)*fac_shield(j) &
4418 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4420 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4421 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
4422 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
4423 +aggj1(l,4)*muij(4))&
4425 *fac_shield(i)*fac_shield(j) &
4426 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4428 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4431 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
4432 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
4433 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
4434 .and. num_conti.le.maxconts) then
4435 ! write (iout,*) i,j," entered corr"
4437 ! Calculate the contact function. The ith column of the array JCONT will
4438 ! contain the numbers of atoms that make contacts with the atom I (of numbers
4439 ! greater than I). The arrays FACONT and GACONT will contain the values of
4440 ! the contact function and its derivative.
4441 ! r0ij=1.02D0*rpp(iteli,itelj)
4442 ! r0ij=1.11D0*rpp(iteli,itelj)
4443 r0ij=2.20D0*rpp(iteli,itelj)
4444 ! r0ij=1.55D0*rpp(iteli,itelj)
4445 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4446 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
4447 if (fcont.gt.0.0D0) then
4448 num_conti=num_conti+1
4449 if (num_conti.gt.maxconts) then
4450 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
4451 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
4452 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
4453 ' will skip next contacts for this conf.', num_conti
4455 jcont_hb(num_conti,i)=j
4456 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
4457 !d & " jcont_hb",jcont_hb(num_conti,i)
4458 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
4459 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4460 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4462 d_cont(num_conti,i)=rij
4463 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4464 ! --- Electrostatic-interaction matrix ---
4465 a_chuj(1,1,num_conti,i)=a22
4466 a_chuj(1,2,num_conti,i)=a23
4467 a_chuj(2,1,num_conti,i)=a32
4468 a_chuj(2,2,num_conti,i)=a33
4469 ! --- Gradient of rij
4471 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4478 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4479 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4480 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4481 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4482 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4487 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4488 ! Calculate contact energies
4490 wij=cosa-3.0D0*cosb*cosg
4493 ! fac3=dsqrt(-ael6i)/r0ij**3
4494 fac3=dsqrt(-ael6i)*r3ij
4495 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4496 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4497 if (ees0tmp.gt.0) then
4498 ees0pij=dsqrt(ees0tmp)
4502 if (shield_mode.eq.0) then
4506 ees0plist(num_conti,i)=j
4508 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4509 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4510 if (ees0tmp.gt.0) then
4511 ees0mij=dsqrt(ees0tmp)
4516 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
4518 *fac_shield(i)*fac_shield(j)
4519 ! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4521 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
4523 *fac_shield(i)*fac_shield(j)
4524 ! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4526 ! Diagnostics. Comment out or remove after debugging!
4527 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4528 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4529 ! ees0m(num_conti,i)=0.0D0
4531 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4532 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4533 ! Angular derivatives of the contact function
4534 ees0pij1=fac3/ees0pij
4535 ees0mij1=fac3/ees0mij
4536 fac3p=-3.0D0*fac3*rrmij
4537 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4538 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4540 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4541 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4542 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4543 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4544 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4545 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4546 ecosap=ecosa1+ecosa2
4547 ecosbp=ecosb1+ecosb2
4548 ecosgp=ecosg1+ecosg2
4549 ecosam=ecosa1-ecosa2
4550 ecosbm=ecosb1-ecosb2
4551 ecosgm=ecosg1-ecosg2
4560 facont_hb(num_conti,i)=fcont
4561 fprimcont=fprimcont/rij
4562 !d facont_hb(num_conti,i)=1.0D0
4563 ! Following line is for diagnostics.
4566 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4567 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4570 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4571 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4573 gggp(1)=gggp(1)+ees0pijp*xj &
4574 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4575 gggp(2)=gggp(2)+ees0pijp*yj &
4576 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4577 gggp(3)=gggp(3)+ees0pijp*zj &
4578 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4580 gggm(1)=gggm(1)+ees0mijp*xj &
4581 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4583 gggm(2)=gggm(2)+ees0mijp*yj &
4584 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4586 gggm(3)=gggm(3)+ees0mijp*zj &
4587 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4589 ! Derivatives due to the contact function
4590 gacont_hbr(1,num_conti,i)=fprimcont*xj
4591 gacont_hbr(2,num_conti,i)=fprimcont*yj
4592 gacont_hbr(3,num_conti,i)=fprimcont*zj
4595 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
4596 ! following the change of gradient-summation algorithm.
4598 !grad ghalfp=0.5D0*gggp(k)
4599 !grad ghalfm=0.5D0*gggm(k)
4600 gacontp_hb1(k,num_conti,i)= & !ghalfp+
4601 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4602 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4603 *sss_ele_cut*fac_shield(i)*fac_shield(j) ! &
4604 ! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4607 gacontp_hb2(k,num_conti,i)= & !ghalfp+
4608 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4609 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4610 *sss_ele_cut*fac_shield(i)*fac_shield(j)! &
4611 ! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4614 gacontp_hb3(k,num_conti,i)=gggp(k) &
4615 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4616 ! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4618 gacontm_hb1(k,num_conti,i)= & !ghalfm+
4619 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4620 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4621 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4622 ! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4624 gacontm_hb2(k,num_conti,i)= & !ghalfm+
4625 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4626 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
4627 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4628 ! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4630 gacontm_hb3(k,num_conti,i)=gggm(k) &
4631 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4632 ! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4635 ! Diagnostics. Comment out or remove after debugging!
4637 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4638 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4639 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4640 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4641 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4642 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4645 endif ! num_conti.le.maxconts
4648 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4651 ghalf=0.5d0*agg(l,k)
4652 aggi(l,k)=aggi(l,k)+ghalf
4653 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4654 aggj(l,k)=aggj(l,k)+ghalf
4657 if (j.eq.nres-1 .and. i.lt.j-2) then
4660 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4666 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4668 end subroutine eelecij
4669 !-----------------------------------------------------------------------------
4670 subroutine eturn3(i,eello_turn3)
4671 ! Third- and fourth-order contributions from turns
4674 ! implicit real*8 (a-h,o-z)
4675 ! include 'DIMENSIONS'
4676 ! include 'COMMON.IOUNITS'
4677 ! include 'COMMON.GEO'
4678 ! include 'COMMON.VAR'
4679 ! include 'COMMON.LOCAL'
4680 ! include 'COMMON.CHAIN'
4681 ! include 'COMMON.DERIV'
4682 ! include 'COMMON.INTERACT'
4683 ! include 'COMMON.CONTACTS'
4684 ! include 'COMMON.TORSION'
4685 ! include 'COMMON.VECTORS'
4686 ! include 'COMMON.FFIELD'
4687 ! include 'COMMON.CONTROL'
4688 real(kind=8),dimension(3) :: ggg
4689 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4690 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2,gpizda1,&
4691 gpizda2,auxgmat1,auxgmatt1,auxgmat2,auxgmatt2
4693 real(kind=8),dimension(2) :: auxvec,auxvec1
4694 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4695 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4696 !el integer :: num_conti,j1,j2
4697 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4698 !el dz_normi,xmedi,ymedi,zmedi
4700 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4701 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4704 integer :: i,j,l,k,ilist,iresshield
4705 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield,xj,yj
4709 ! write (iout,*) "eturn3",i,j,j1,j2
4710 zj=(c(3,j)+c(3,j+1))/2.0d0
4711 call to_box(xj,yj,zj)
4712 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
4718 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4720 ! Third-order contributions
4727 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4728 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4729 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4730 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4731 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4732 call transpose2(auxmat(1,1),auxmat1(1,1))
4733 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4734 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4735 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4736 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4737 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4739 if (shield_mode.eq.0) then
4744 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4745 *fac_shield(i)*fac_shield(j) &
4746 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4748 0.5d0*(pizda(1,1)+pizda(2,2)) &
4749 *fac_shield(i)*fac_shield(j)
4751 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4752 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4754 !C Derivatives in theta
4755 gloc(nphi+i,icg)=gloc(nphi+i,icg) &
4756 +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3&
4757 *fac_shield(i)*fac_shield(j) &
4758 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4760 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)&
4761 +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3&
4762 *fac_shield(i)*fac_shield(j) &
4763 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4770 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4771 (shield_mode.gt.0)) then
4774 do ilist=1,ishield_list(i)
4775 iresshield=shield_list(ilist,i)
4777 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4778 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4780 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4781 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4785 do ilist=1,ishield_list(j)
4786 iresshield=shield_list(ilist,j)
4788 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4789 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4791 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4792 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4799 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4800 grad_shield(k,i)*eello_t3/fac_shield(i)
4801 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4802 grad_shield(k,j)*eello_t3/fac_shield(j)
4803 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4804 grad_shield(k,i)*eello_t3/fac_shield(i)
4805 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4806 grad_shield(k,j)*eello_t3/fac_shield(j)
4810 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4811 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4812 !d & ' eello_turn3_num',4*eello_turn3_num
4813 ! Derivatives in gamma(i)
4814 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4815 call transpose2(auxmat2(1,1),auxmat3(1,1))
4816 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4817 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4818 *fac_shield(i)*fac_shield(j) &
4819 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4820 ! Derivatives in gamma(i+1)
4821 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4822 call transpose2(auxmat2(1,1),auxmat3(1,1))
4823 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4824 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4825 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4826 *fac_shield(i)*fac_shield(j) &
4827 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4829 ! Cartesian derivatives
4831 ! ghalf1=0.5d0*agg(l,1)
4832 ! ghalf2=0.5d0*agg(l,2)
4833 ! ghalf3=0.5d0*agg(l,3)
4834 ! ghalf4=0.5d0*agg(l,4)
4835 a_temp(1,1)=aggi(l,1)!+ghalf1
4836 a_temp(1,2)=aggi(l,2)!+ghalf2
4837 a_temp(2,1)=aggi(l,3)!+ghalf3
4838 a_temp(2,2)=aggi(l,4)!+ghalf4
4839 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4840 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4841 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4842 *fac_shield(i)*fac_shield(j) &
4843 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4845 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4846 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4847 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4848 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4849 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4850 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4851 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4852 *fac_shield(i)*fac_shield(j) &
4853 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4855 a_temp(1,1)=aggj(l,1)!+ghalf1
4856 a_temp(1,2)=aggj(l,2)!+ghalf2
4857 a_temp(2,1)=aggj(l,3)!+ghalf3
4858 a_temp(2,2)=aggj(l,4)!+ghalf4
4859 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4860 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4861 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4862 *fac_shield(i)*fac_shield(j) &
4863 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4865 a_temp(1,1)=aggj1(l,1)
4866 a_temp(1,2)=aggj1(l,2)
4867 a_temp(2,1)=aggj1(l,3)
4868 a_temp(2,2)=aggj1(l,4)
4869 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4870 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4871 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4872 *fac_shield(i)*fac_shield(j) &
4873 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4875 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4876 ssgradlipi*eello_t3/4.0d0*lipscale
4877 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4878 ssgradlipj*eello_t3/4.0d0*lipscale
4879 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4880 ssgradlipi*eello_t3/4.0d0*lipscale
4881 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4882 ssgradlipj*eello_t3/4.0d0*lipscale
4885 end subroutine eturn3
4886 !-----------------------------------------------------------------------------
4887 subroutine eturn4(i,eello_turn4)
4888 ! Third- and fourth-order contributions from turns
4891 ! implicit real*8 (a-h,o-z)
4892 ! include 'DIMENSIONS'
4893 ! include 'COMMON.IOUNITS'
4894 ! include 'COMMON.GEO'
4895 ! include 'COMMON.VAR'
4896 ! include 'COMMON.LOCAL'
4897 ! include 'COMMON.CHAIN'
4898 ! include 'COMMON.DERIV'
4899 ! include 'COMMON.INTERACT'
4900 ! include 'COMMON.CONTACTS'
4901 ! include 'COMMON.TORSION'
4902 ! include 'COMMON.VECTORS'
4903 ! include 'COMMON.FFIELD'
4904 ! include 'COMMON.CONTROL'
4905 real(kind=8),dimension(3) :: ggg
4906 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4907 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2,&
4909 gte1a,gtae3,gtae3e2, ae3gte2,&
4910 gtEpizda1,gtEpizda2,gtEpizda3
4912 real(kind=8),dimension(2) :: auxvec,auxvec1,auxgEvec1,auxgEvec2,&
4915 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4916 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4917 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4918 !el dz_normi,xmedi,ymedi,zmedi
4919 !el integer :: num_conti,j1,j2
4920 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4921 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4924 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4925 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4926 rlocshield,gs23,gs32,gsE13,gs13,gs21,gsE31,gsEE1,gsEE2,gsEE3,xj,yj
4930 ! if (j.ne.20) return
4931 ! print *,i,j,gshieldc_t4(2,j),gshieldc_t4(2,j+1)
4932 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4934 ! Fourth-order contributions
4942 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4943 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4944 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4945 zj=(c(3,j)+c(3,j+1))/2.0d0
4946 call to_box(xj,yj,zj)
4947 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
4957 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4958 call transpose2(EUg(1,1,i+1),e1t(1,1))
4959 call transpose2(Eug(1,1,i+2),e2t(1,1))
4960 call transpose2(Eug(1,1,i+3),e3t(1,1))
4961 !C Ematrix derivative in theta
4962 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4963 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4964 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4966 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4967 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4968 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4969 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4970 !c auxalary matrix of E i+1
4971 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4972 s1=scalar2(b1(1,iti2),auxvec(1))
4973 !c derivative of theta i+2 with constant i+3
4974 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4975 !c derivative of theta i+2 with constant i+2
4976 gs32=scalar2(b1(1,i+2),auxgvec(1))
4977 !c derivative of E matix in theta of i+1
4978 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4980 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4981 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4982 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4983 !c auxilary matrix auxgvec of Ub2 with constant E matirx
4984 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4985 !c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4986 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4987 s2=scalar2(b1(1,i+1),auxvec(1))
4988 !c derivative of theta i+1 with constant i+3
4989 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4990 !c derivative of theta i+2 with constant i+1
4991 gs21=scalar2(b1(1,i+1),auxgvec(1))
4992 !c derivative of theta i+3 with constant i+1
4993 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4995 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4996 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4997 !c ae3gte2 is derivative over i+2
4998 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
5000 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5001 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
5003 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
5005 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
5007 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5008 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
5009 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
5010 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
5011 if (shield_mode.eq.0) then
5016 eello_turn4=eello_turn4-(s1+s2+s3) &
5017 *fac_shield(i)*fac_shield(j) &
5018 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5019 eello_t4=-(s1+s2+s3) &
5020 *fac_shield(i)*fac_shield(j)
5021 !C Now derivative over shield:
5022 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
5023 (shield_mode.gt.0)) then
5026 do ilist=1,ishield_list(i)
5027 iresshield=shield_list(ilist,i)
5029 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
5030 ! print *,"rlocshield",rlocshield,grad_shield_side(k,ilist,i),iresshield
5031 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
5033 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
5034 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
5038 do ilist=1,ishield_list(j)
5039 iresshield=shield_list(ilist,j)
5041 ! print *,"rlocshieldj",j,rlocshield,grad_shield_side(k,ilist,j),iresshield
5042 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
5043 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
5045 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
5046 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
5048 ! print *,"after", gshieldc_t4(k,iresshield-1),iresshield-1,gshieldc_t4(k,iresshield)
5053 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
5054 grad_shield(k,i)*eello_t4/fac_shield(i)
5055 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
5056 grad_shield(k,j)*eello_t4/fac_shield(j)
5057 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
5058 grad_shield(k,i)*eello_t4/fac_shield(i)
5059 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
5060 grad_shield(k,j)*eello_t4/fac_shield(j)
5061 ! print *,"gshieldc_t4(k,j+1)",j,gshieldc_t4(k,j+1)
5065 gloc(nphi+i,icg)=gloc(nphi+i,icg)&
5066 -(gs13+gsE13+gsEE1)*wturn4&
5067 *fac_shield(i)*fac_shield(j) &
5068 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5070 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)&
5071 -(gs23+gs21+gsEE2)*wturn4&
5072 *fac_shield(i)*fac_shield(j)&
5073 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5075 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)&
5076 -(gs32+gsE31+gsEE3)*wturn4&
5077 *fac_shield(i)*fac_shield(j)&
5078 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5081 !c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5084 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5085 'eturn4',i,j,-(s1+s2+s3)
5086 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5087 !d & ' eello_turn4_num',8*eello_turn4_num
5088 ! Derivatives in gamma(i)
5089 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5090 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5091 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5092 s1=scalar2(b1(1,i+1),auxvec(1))
5093 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5094 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5095 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
5096 *fac_shield(i)*fac_shield(j) &
5097 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5099 ! Derivatives in gamma(i+1)
5100 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5101 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5102 s2=scalar2(b1(1,iti1),auxvec(1))
5103 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5104 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5105 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5106 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
5107 *fac_shield(i)*fac_shield(j) &
5108 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5110 ! Derivatives in gamma(i+2)
5111 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5112 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5113 s1=scalar2(b1(1,iti2),auxvec(1))
5114 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5115 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5116 s2=scalar2(b1(1,iti1),auxvec(1))
5117 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5118 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5119 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5120 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
5121 *fac_shield(i)*fac_shield(j) &
5122 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5124 ! Cartesian derivatives
5125 ! Derivatives of this turn contributions in DC(i+2)
5126 if (j.lt.nres-1) then
5128 a_temp(1,1)=agg(l,1)
5129 a_temp(1,2)=agg(l,2)
5130 a_temp(2,1)=agg(l,3)
5131 a_temp(2,2)=agg(l,4)
5132 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5133 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5134 s1=scalar2(b1(1,iti2),auxvec(1))
5135 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5136 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5137 s2=scalar2(b1(1,iti1),auxvec(1))
5138 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5139 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5140 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5142 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
5143 *fac_shield(i)*fac_shield(j) &
5144 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5148 ! Remaining derivatives of this turn contribution
5150 a_temp(1,1)=aggi(l,1)
5151 a_temp(1,2)=aggi(l,2)
5152 a_temp(2,1)=aggi(l,3)
5153 a_temp(2,2)=aggi(l,4)
5154 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5155 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5156 s1=scalar2(b1(1,iti2),auxvec(1))
5157 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5158 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5159 s2=scalar2(b1(1,iti1),auxvec(1))
5160 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5161 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5162 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5163 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
5164 *fac_shield(i)*fac_shield(j) &
5165 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5168 a_temp(1,1)=aggi1(l,1)
5169 a_temp(1,2)=aggi1(l,2)
5170 a_temp(2,1)=aggi1(l,3)
5171 a_temp(2,2)=aggi1(l,4)
5172 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5173 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5174 s1=scalar2(b1(1,iti2),auxvec(1))
5175 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5176 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5177 s2=scalar2(b1(1,iti1),auxvec(1))
5178 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5179 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5180 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5181 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
5182 *fac_shield(i)*fac_shield(j) &
5183 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5186 a_temp(1,1)=aggj(l,1)
5187 a_temp(1,2)=aggj(l,2)
5188 a_temp(2,1)=aggj(l,3)
5189 a_temp(2,2)=aggj(l,4)
5190 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5191 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5192 s1=scalar2(b1(1,iti2),auxvec(1))
5193 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5194 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5195 s2=scalar2(b1(1,iti1),auxvec(1))
5196 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5197 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5198 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5199 ! if (j.lt.nres-1) then
5200 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
5201 *fac_shield(i)*fac_shield(j) &
5202 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5205 a_temp(1,1)=aggj1(l,1)
5206 a_temp(1,2)=aggj1(l,2)
5207 a_temp(2,1)=aggj1(l,3)
5208 a_temp(2,2)=aggj1(l,4)
5209 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5210 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5211 s1=scalar2(b1(1,iti2),auxvec(1))
5212 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5213 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5214 s2=scalar2(b1(1,iti1),auxvec(1))
5215 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5216 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5217 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5218 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5219 ! if (j.lt.nres-1) then
5220 ! print *,"juest before",j1, gcorr4_turn(l,j1)
5221 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
5222 *fac_shield(i)*fac_shield(j) &
5223 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5224 ! if (shield_mode.gt.0) then
5225 ! print *,"juest after",j1, gcorr4_turn(l,j1),gshieldc_t4(k,j1),gshieldc_loc_t4(k,j1),gel_loc_turn4(i+2)
5227 ! print *,"juest after",j1, gcorr4_turn(l,j1),gel_loc_turn4(i+2)
5231 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
5232 ssgradlipi*eello_t4/4.0d0*lipscale
5233 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
5234 ssgradlipj*eello_t4/4.0d0*lipscale
5235 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
5236 ssgradlipi*eello_t4/4.0d0*lipscale
5237 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
5238 ssgradlipj*eello_t4/4.0d0*lipscale
5241 end subroutine eturn4
5242 !-----------------------------------------------------------------------------
5243 subroutine unormderiv(u,ugrad,unorm,ungrad)
5244 ! This subroutine computes the derivatives of a normalized vector u, given
5245 ! the derivatives computed without normalization conditions, ugrad. Returns
5248 real(kind=8),dimension(3) :: u,vec
5249 real(kind=8),dimension(3,3) ::ugrad,ungrad
5250 real(kind=8) :: unorm !,scalar
5252 ! write (2,*) 'ugrad',ugrad
5255 vec(i)=scalar(ugrad(1,i),u(1))
5257 ! write (2,*) 'vec',vec
5260 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5263 ! write (2,*) 'ungrad',ungrad
5265 end subroutine unormderiv
5266 !-----------------------------------------------------------------------------
5267 subroutine escp_soft_sphere(evdw2,evdw2_14)
5269 ! This subroutine calculates the excluded-volume interaction energy between
5270 ! peptide-group centers and side chains and its gradient in virtual-bond and
5271 ! side-chain vectors.
5273 ! implicit real*8 (a-h,o-z)
5274 ! include 'DIMENSIONS'
5275 ! include 'COMMON.GEO'
5276 ! include 'COMMON.VAR'
5277 ! include 'COMMON.LOCAL'
5278 ! include 'COMMON.CHAIN'
5279 ! include 'COMMON.DERIV'
5280 ! include 'COMMON.INTERACT'
5281 ! include 'COMMON.FFIELD'
5282 ! include 'COMMON.IOUNITS'
5283 ! include 'COMMON.CONTROL'
5284 real(kind=8),dimension(3) :: ggg
5286 integer :: i,iint,j,k,iteli,itypj
5287 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
5288 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
5293 !d print '(a)','Enter ESCP'
5294 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5295 do i=iatscp_s,iatscp_e
5296 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
5298 xi=0.5D0*(c(1,i)+c(1,i+1))
5299 yi=0.5D0*(c(2,i)+c(2,i+1))
5300 zi=0.5D0*(c(3,i)+c(3,i+1))
5301 call to_box(xi,yi,zi)
5303 do iint=1,nscp_gr(i)
5305 do j=iscpstart(i,iint),iscpend(i,iint)
5306 if (itype(j,1).eq.ntyp1) cycle
5307 itypj=iabs(itype(j,1))
5308 ! Uncomment following three lines for SC-p interactions
5312 ! Uncomment following three lines for Ca-p interactions
5316 call to_box(xj,yj,zj)
5317 xj=boxshift(xj-xi,boxxsize)
5318 yj=boxshift(yj-yi,boxysize)
5319 zj=boxshift(zj-zi,boxzsize)
5320 rij=xj*xj+yj*yj+zj*zj
5323 if (rij.lt.r0ijsq) then
5324 evdwij=0.25d0*(rij-r0ijsq)**2
5332 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5337 !grad if (j.lt.i) then
5338 !d write (iout,*) 'j<i'
5339 ! Uncomment following three lines for SC-p interactions
5341 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5344 !d write (iout,*) 'j>i'
5346 !grad ggg(k)=-ggg(k)
5347 ! Uncomment following line for SC-p interactions
5348 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5352 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5354 !grad kstart=min0(i+1,j)
5355 !grad kend=max0(i-1,j-1)
5356 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5357 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5358 !grad do k=kstart,kend
5360 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5364 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5365 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5372 end subroutine escp_soft_sphere
5373 !-----------------------------------------------------------------------------
5374 subroutine escp(evdw2,evdw2_14)
5376 ! This subroutine calculates the excluded-volume interaction energy between
5377 ! peptide-group centers and side chains and its gradient in virtual-bond and
5378 ! side-chain vectors.
5380 ! implicit real*8 (a-h,o-z)
5381 ! include 'DIMENSIONS'
5382 ! include 'COMMON.GEO'
5383 ! include 'COMMON.VAR'
5384 ! include 'COMMON.LOCAL'
5385 ! include 'COMMON.CHAIN'
5386 ! include 'COMMON.DERIV'
5387 ! include 'COMMON.INTERACT'
5388 ! include 'COMMON.FFIELD'
5389 ! include 'COMMON.IOUNITS'
5390 ! include 'COMMON.CONTROL'
5391 real(kind=8),dimension(3) :: ggg
5393 integer :: i,iint,j,k,iteli,itypj,subchap,icont
5394 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
5396 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
5397 dist_temp, dist_init
5398 integer xshift,yshift,zshift
5402 !d print '(a)','Enter ESCP'
5403 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5404 ! do i=iatscp_s,iatscp_e
5405 if (nres_molec(1).eq.0) return
5406 do icont=g_listscp_start,g_listscp_end
5407 i=newcontlistscpi(icont)
5408 j=newcontlistscpj(icont)
5409 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
5411 xi=0.5D0*(c(1,i)+c(1,i+1))
5412 yi=0.5D0*(c(2,i)+c(2,i+1))
5413 zi=0.5D0*(c(3,i)+c(3,i+1))
5414 call to_box(xi,yi,zi)
5416 ! do iint=1,nscp_gr(i)
5418 ! do j=iscpstart(i,iint),iscpend(i,iint)
5419 itypj=iabs(itype(j,1))
5420 if (itypj.eq.ntyp1) cycle
5421 ! Uncomment following three lines for SC-p interactions
5425 ! Uncomment following three lines for Ca-p interactions
5433 call to_box(xj,yj,zj)
5434 xj=boxshift(xj-xi,boxxsize)
5435 yj=boxshift(yj-yi,boxysize)
5436 zj=boxshift(zj-zi,boxzsize)
5438 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5439 rij=dsqrt(1.0d0/rrij)
5440 sss_ele_cut=sscale_ele(rij)
5441 sss_ele_grad=sscagrad_ele(rij)
5442 ! print *,sss_ele_cut,sss_ele_grad,&
5443 ! (rij),r_cut_ele,rlamb_ele
5444 if (sss_ele_cut.le.0.0) cycle
5446 e1=fac*fac*aad(itypj,iteli)
5447 e2=fac*bad(itypj,iteli)
5448 if (iabs(j-i) .le. 2) then
5451 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
5454 evdw2=evdw2+evdwij*sss_ele_cut
5455 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
5456 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
5457 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5460 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5462 fac=-(evdwij+e1)*rrij*sss_ele_cut
5463 fac=fac+evdwij*sss_ele_grad/rij/expon
5467 !grad if (j.lt.i) then
5468 !d write (iout,*) 'j<i'
5469 ! Uncomment following three lines for SC-p interactions
5471 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5474 !d write (iout,*) 'j>i'
5476 !grad ggg(k)=-ggg(k)
5477 ! Uncomment following line for SC-p interactions
5478 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5479 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5483 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5485 !grad kstart=min0(i+1,j)
5486 !grad kend=max0(i-1,j-1)
5487 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5488 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5489 !grad do k=kstart,kend
5491 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5495 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5496 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5504 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5505 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5506 gradx_scp(j,i)=expon*gradx_scp(j,i)
5509 !******************************************************************************
5513 ! To save time the factor EXPON has been extracted from ALL components
5514 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
5517 !******************************************************************************
5520 !-----------------------------------------------------------------------------
5521 subroutine edis(ehpb)
5523 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5525 ! implicit real*8 (a-h,o-z)
5526 ! include 'DIMENSIONS'
5527 ! include 'COMMON.SBRIDGE'
5528 ! include 'COMMON.CHAIN'
5529 ! include 'COMMON.DERIV'
5530 ! include 'COMMON.VAR'
5531 ! include 'COMMON.INTERACT'
5532 ! include 'COMMON.IOUNITS'
5533 real(kind=8),dimension(3) :: ggg
5535 integer :: i,j,ii,jj,iii,jjj,k
5536 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
5539 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5540 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
5541 if (link_end.eq.0) return
5542 do i=link_start,link_end
5543 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5544 ! CA-CA distance used in regularization of structure.
5547 ! iii and jjj point to the residues for which the distance is assigned.
5548 if (ii.gt.nres) then
5555 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5556 ! & dhpb(i),dhpb1(i),forcon(i)
5557 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
5558 ! distance and angle dependent SS bond potential.
5559 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5560 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5561 if (.not.dyn_ss .and. i.le.nss) then
5562 ! 15/02/13 CC dynamic SSbond - additional check
5563 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
5564 iabs(itype(jjj,1)).eq.1) then
5565 call ssbond_ene(iii,jjj,eij)
5567 ! write (iout,*) "eij",eij,iii,jjj
5569 else if (ii.gt.nres .and. jj.gt.nres) then
5570 !c Restraints from contact prediction
5572 if (constr_dist.eq.11) then
5573 ehpb=ehpb+fordepth(i)**4.0d0 &
5574 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5575 fac=fordepth(i)**4.0d0 &
5576 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5577 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5580 if (dhpb1(i).gt.0.0d0) then
5581 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5582 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5583 !c write (iout,*) "beta nmr",
5584 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5588 !C Get the force constant corresponding to this distance.
5590 !C Calculate the contribution to energy.
5591 ehpb=ehpb+waga*rdis*rdis
5592 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
5594 !C Evaluate gradient.
5600 ggg(j)=fac*(c(j,jj)-c(j,ii))
5603 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5604 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5607 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5608 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5612 if (constr_dist.eq.11) then
5613 ehpb=ehpb+fordepth(i)**4.0d0 &
5614 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5615 fac=fordepth(i)**4.0d0 &
5616 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5617 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5620 if (dhpb1(i).gt.0.0d0) then
5621 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5622 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5623 !c write (iout,*) "alph nmr",
5624 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5627 !C Get the force constant corresponding to this distance.
5629 !C Calculate the contribution to energy.
5630 ehpb=ehpb+waga*rdis*rdis
5631 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5633 !C Evaluate gradient.
5640 ggg(j)=fac*(c(j,jj)-c(j,ii))
5642 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5643 !C If this is a SC-SC distance, we need to calculate the contributions to the
5644 !C Cartesian gradient in the SC vectors (ghpbx).
5647 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5648 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5651 !cgrad do j=iii,jjj-1
5653 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5657 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5658 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5662 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5666 !-----------------------------------------------------------------------------
5667 subroutine ssbond_ene(i,j,eij)
5669 ! Calculate the distance and angle dependent SS-bond potential energy
5670 ! using a free-energy function derived based on RHF/6-31G** ab initio
5671 ! calculations of diethyl disulfide.
5673 ! A. Liwo and U. Kozlowska, 11/24/03
5675 ! implicit real*8 (a-h,o-z)
5676 ! include 'DIMENSIONS'
5677 ! include 'COMMON.SBRIDGE'
5678 ! include 'COMMON.CHAIN'
5679 ! include 'COMMON.DERIV'
5680 ! include 'COMMON.LOCAL'
5681 ! include 'COMMON.INTERACT'
5682 ! include 'COMMON.VAR'
5683 ! include 'COMMON.IOUNITS'
5684 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5686 integer :: i,j,itypi,itypj,k
5687 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5688 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5689 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5692 itypi=iabs(itype(i,1))
5696 call to_box(xi,yi,zi)
5698 dxi=dc_norm(1,nres+i)
5699 dyi=dc_norm(2,nres+i)
5700 dzi=dc_norm(3,nres+i)
5701 ! dsci_inv=dsc_inv(itypi)
5702 dsci_inv=vbld_inv(nres+i)
5703 itypj=iabs(itype(j,1))
5704 ! dscj_inv=dsc_inv(itypj)
5705 dscj_inv=vbld_inv(nres+j)
5709 call to_box(xj,yj,zj)
5710 xj=boxshift(xj-xi,boxxsize)
5711 yj=boxshift(yj-yi,boxysize)
5712 zj=boxshift(zj-zi,boxzsize)
5713 dxj=dc_norm(1,nres+j)
5714 dyj=dc_norm(2,nres+j)
5715 dzj=dc_norm(3,nres+j)
5716 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5721 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5722 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5723 om12=dxi*dxj+dyi*dyj+dzi*dzj
5725 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5726 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5732 deltat12=om2-om1+2.0d0
5734 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5735 +akct*deltad*deltat12 &
5736 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5737 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, &
5738 ! " akct",akct," deltad",deltad," deltat",deltat1,deltat2, &
5739 ! " deltat12",deltat12," eij",eij
5740 ed=2*akcm*deltad+akct*deltat12
5742 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5743 eom1=-2*akth*deltat1-pom1-om2*pom2
5744 eom2= 2*akth*deltat2+pom1-om1*pom2
5747 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5748 ghpbx(k,i)=ghpbx(k,i)-ggk &
5749 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5750 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5751 ghpbx(k,j)=ghpbx(k,j)+ggk &
5752 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5753 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5754 ghpbc(k,i)=ghpbc(k,i)-ggk
5755 ghpbc(k,j)=ghpbc(k,j)+ggk
5758 ! Calculate the components of the gradient in DC and X
5762 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5766 end subroutine ssbond_ene
5767 !-----------------------------------------------------------------------------
5768 subroutine ebond(estr)
5770 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5772 ! implicit real*8 (a-h,o-z)
5773 ! include 'DIMENSIONS'
5774 ! include 'COMMON.LOCAL'
5775 ! include 'COMMON.GEO'
5776 ! include 'COMMON.INTERACT'
5777 ! include 'COMMON.DERIV'
5778 ! include 'COMMON.VAR'
5779 ! include 'COMMON.CHAIN'
5780 ! include 'COMMON.IOUNITS'
5781 ! include 'COMMON.NAMES'
5782 ! include 'COMMON.FFIELD'
5783 ! include 'COMMON.CONTROL'
5784 ! include 'COMMON.SETUP'
5785 real(kind=8),dimension(3) :: u,ud
5787 integer :: i,j,iti,nbi,k
5788 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5793 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5794 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5796 do i=ibondp_start,ibondp_end
5797 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5798 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5799 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5801 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5802 !C *dc(j,i-1)/vbld(i)
5804 !C if (energy_dec) write(iout,*) &
5805 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5806 diff = vbld(i)-vbldpDUM
5808 diff = vbld(i)-vbldp0
5810 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5811 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5814 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5816 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5819 estr=0.5d0*AKP*estr+estr1
5820 ! print *,"estr_bb",estr,AKP
5822 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5824 do i=ibond_start,ibond_end
5825 iti=iabs(itype(i,1))
5826 if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
5827 if (iti.ne.10 .and. iti.ne.ntyp1) then
5830 diff=vbld(i+nres)-vbldsc0(1,iti)
5831 if (energy_dec) write (iout,*) &
5832 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5833 AKSC(1,iti),AKSC(1,iti)*diff*diff
5834 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5835 ! print *,"estr_sc",estr
5837 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5841 diff=vbld(i+nres)-vbldsc0(j,iti)
5842 ud(j)=aksc(j,iti)*diff
5843 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5857 uprod2=uprod2*u(k)*u(k)
5861 usumsqder=usumsqder+ud(j)*uprod2
5863 estr=estr+uprod/usum
5864 ! print *,"estr_sc",estr,i
5866 if (energy_dec) write (iout,*) &
5867 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5868 AKSC(1,iti),uprod/usum
5870 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5876 end subroutine ebond
5878 !-----------------------------------------------------------------------------
5879 subroutine ebend(etheta)
5881 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5882 ! angles gamma and its derivatives in consecutive thetas and gammas.
5885 ! implicit real*8 (a-h,o-z)
5886 ! include 'DIMENSIONS'
5887 ! include 'COMMON.LOCAL'
5888 ! include 'COMMON.GEO'
5889 ! include 'COMMON.INTERACT'
5890 ! include 'COMMON.DERIV'
5891 ! include 'COMMON.VAR'
5892 ! include 'COMMON.CHAIN'
5893 ! include 'COMMON.IOUNITS'
5894 ! include 'COMMON.NAMES'
5895 ! include 'COMMON.FFIELD'
5896 ! include 'COMMON.CONTROL'
5897 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5898 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5899 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5901 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5902 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5903 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5905 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5907 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5908 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5909 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5910 real(kind=8),dimension(2) :: y,z
5913 ! time11=dexp(-2*time)
5916 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5917 do i=ithet_start,ithet_end
5918 if (itype(i-1,1).eq.ntyp1) cycle
5919 ! Zero the energy function and its derivative at 0 or pi.
5920 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5922 ichir1=isign(1,itype(i-2,1))
5923 ichir2=isign(1,itype(i,1))
5924 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
5925 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
5926 if (itype(i-1,1).eq.10) then
5927 itype1=isign(10,itype(i-2,1))
5928 ichir11=isign(1,itype(i-2,1))
5929 ichir12=isign(1,itype(i-2,1))
5930 itype2=isign(10,itype(i,1))
5931 ichir21=isign(1,itype(i,1))
5932 ichir22=isign(1,itype(i,1))
5935 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
5938 if (phii.ne.phii) phii=150.0
5948 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
5951 if (phii1.ne.phii1) phii1=150.0
5963 ! Calculate the "mean" value of theta from the part of the distribution
5964 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5965 ! In following comments this theta will be referred to as t_c.
5966 thet_pred_mean=0.0d0
5968 athetk=athet(k,it,ichir1,ichir2)
5969 bthetk=bthet(k,it,ichir1,ichir2)
5971 athetk=athet(k,itype1,ichir11,ichir12)
5972 bthetk=bthet(k,itype2,ichir21,ichir22)
5974 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5976 dthett=thet_pred_mean*ssd
5977 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5978 ! Derivatives of the "mean" values in gamma1 and gamma2.
5979 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5980 +athet(2,it,ichir1,ichir2)*y(1))*ss
5981 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5982 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5984 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5985 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5986 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5987 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5989 if (theta(i).gt.pi-delta) then
5990 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5992 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5993 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5994 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5996 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5998 else if (theta(i).lt.delta) then
5999 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6000 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6001 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
6003 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6004 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
6007 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
6010 etheta=etheta+ethetai
6011 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6013 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6014 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6015 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
6017 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
6019 ! Ufff.... We've done all this!!!
6021 end subroutine ebend
6022 !-----------------------------------------------------------------------------
6023 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
6026 ! implicit real*8 (a-h,o-z)
6027 ! include 'DIMENSIONS'
6028 ! include 'COMMON.LOCAL'
6029 ! include 'COMMON.IOUNITS'
6030 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
6031 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
6032 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
6034 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
6036 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
6037 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
6038 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6040 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
6041 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
6043 ! Calculate the contributions to both Gaussian lobes.
6044 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6045 ! The "polynomial part" of the "standard deviation" of this part of
6049 sig=sig*thet_pred_mean+polthet(j,it)
6051 ! Derivative of the "interior part" of the "standard deviation of the"
6052 ! gamma-dependent Gaussian lobe in t_c.
6053 sigtc=3*polthet(3,it)
6055 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6058 ! Set the parameters of both Gaussian lobes of the distribution.
6059 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6060 fac=sig*sig+sigc0(it)
6063 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6064 sigsqtc=-4.0D0*sigcsq*sigtc
6065 ! print *,i,sig,sigtc,sigsqtc
6066 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
6067 sigtc=-sigtc/(fac*fac)
6068 ! Following variable is sigma(t_c)**(-2)
6069 sigcsq=sigcsq*sigcsq
6071 sig0inv=1.0D0/sig0i**2
6072 delthec=thetai-thet_pred_mean
6073 delthe0=thetai-theta0i
6074 term1=-0.5D0*sigcsq*delthec*delthec
6075 term2=-0.5D0*sig0inv*delthe0*delthe0
6076 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6077 ! NaNs in taking the logarithm. We extract the largest exponent which is added
6078 ! to the energy (this being the log of the distribution) at the end of energy
6079 ! term evaluation for this virtual-bond angle.
6080 if (term1.gt.term2) then
6082 term2=dexp(term2-termm)
6086 term1=dexp(term1-termm)
6089 ! The ratio between the gamma-independent and gamma-dependent lobes of
6090 ! the distribution is a Gaussian function of thet_pred_mean too.
6091 diffak=gthet(2,it)-thet_pred_mean
6092 ratak=diffak/gthet(3,it)**2
6093 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6094 ! Let's differentiate it in thet_pred_mean NOW.
6096 ! Now put together the distribution terms to make complete distribution.
6097 termexp=term1+ak*term2
6098 termpre=sigc+ak*sig0i
6099 ! Contribution of the bending energy from this theta is just the -log of
6100 ! the sum of the contributions from the two lobes and the pre-exponential
6101 ! factor. Simple enough, isn't it?
6102 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6103 ! NOW the derivatives!!!
6104 ! 6/6/97 Take into account the deformation.
6105 E_theta=(delthec*sigcsq*term1 &
6106 +ak*delthe0*sig0inv*term2)/termexp
6107 E_tc=((sigtc+aktc*sig0i)/termpre &
6108 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
6109 aktc*term2)/termexp)
6111 end subroutine theteng
6113 !-----------------------------------------------------------------------------
6114 subroutine ebend(etheta)
6116 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6117 ! angles gamma and its derivatives in consecutive thetas and gammas.
6118 ! ab initio-derived potentials from
6119 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6121 ! implicit real*8 (a-h,o-z)
6122 ! include 'DIMENSIONS'
6123 ! include 'COMMON.LOCAL'
6124 ! include 'COMMON.GEO'
6125 ! include 'COMMON.INTERACT'
6126 ! include 'COMMON.DERIV'
6127 ! include 'COMMON.VAR'
6128 ! include 'COMMON.CHAIN'
6129 ! include 'COMMON.IOUNITS'
6130 ! include 'COMMON.NAMES'
6131 ! include 'COMMON.FFIELD'
6132 ! include 'COMMON.CONTROL'
6133 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
6134 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
6135 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
6136 logical :: lprn=.false., lprn1=.false.
6138 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
6139 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
6140 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
6141 ! local variables for constrains
6142 real(kind=8) :: difi,thetiii
6144 ! write(iout,*) "in ebend",ithet_start,ithet_end
6147 do i=ithet_start,ithet_end
6148 if (itype(i-1,1).eq.ntyp1) cycle
6149 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
6150 if (iabs(itype(i+1,1)).eq.20) iblock=2
6151 if (iabs(itype(i+1,1)).ne.20) iblock=1
6155 theti2=0.5d0*theta(i)
6156 ityp2=ithetyp((itype(i-1,1)))
6158 coskt(k)=dcos(k*theti2)
6159 sinkt(k)=dsin(k*theti2)
6161 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
6164 if (phii.ne.phii) phii=150.0
6168 ityp1=ithetyp((itype(i-2,1)))
6169 ! propagation of chirality for glycine type
6171 cosph1(k)=dcos(k*phii)
6172 sinph1(k)=dsin(k*phii)
6176 ityp1=ithetyp(itype(i-2,1))
6182 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
6185 if (phii1.ne.phii1) phii1=150.0
6190 ityp3=ithetyp((itype(i,1)))
6192 cosph2(k)=dcos(k*phii1)
6193 sinph2(k)=dsin(k*phii1)
6197 ityp3=ithetyp(itype(i,1))
6203 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6206 ccl=cosph1(l)*cosph2(k-l)
6207 ssl=sinph1(l)*sinph2(k-l)
6208 scl=sinph1(l)*cosph2(k-l)
6209 csl=cosph1(l)*sinph2(k-l)
6210 cosph1ph2(l,k)=ccl-ssl
6211 cosph1ph2(k,l)=ccl+ssl
6212 sinph1ph2(l,k)=scl+csl
6213 sinph1ph2(k,l)=scl-csl
6217 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
6218 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6219 write (iout,*) "coskt and sinkt"
6221 write (iout,*) k,coskt(k),sinkt(k)
6225 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6226 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
6229 write (iout,*) "k",k,&
6230 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
6234 write (iout,*) "cosph and sinph"
6236 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6238 write (iout,*) "cosph1ph2 and sinph2ph2"
6241 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
6242 sinph1ph2(l,k),sinph1ph2(k,l)
6245 write(iout,*) "ethetai",ethetai
6249 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
6250 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
6251 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
6252 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6253 ethetai=ethetai+sinkt(m)*aux
6254 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6255 dephii=dephii+k*sinkt(m)* &
6256 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
6257 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6258 dephii1=dephii1+k*sinkt(m)* &
6259 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
6260 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6262 write (iout,*) "m",m," k",k," bbthet", &
6263 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
6264 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
6265 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
6266 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6270 write(iout,*) "ethetai",ethetai
6274 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
6275 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
6276 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
6277 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6278 ethetai=ethetai+sinkt(m)*aux
6279 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6280 dephii=dephii+l*sinkt(m)* &
6281 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
6282 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
6283 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
6284 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6285 dephii1=dephii1+(k-l)*sinkt(m)* &
6286 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
6287 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
6288 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
6289 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6291 write (iout,*) "m",m," k",k," l",l," ffthet",&
6292 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
6293 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
6294 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
6295 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
6297 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
6298 cosph1ph2(k,l)*sinkt(m),&
6299 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6307 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
6308 i,theta(i)*rad2deg,phii*rad2deg,&
6309 phii1*rad2deg,ethetai
6311 etheta=etheta+ethetai
6312 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6314 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6315 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6316 gloc(nphi+i-2,icg)=wang*dethetai
6318 !-----------thete constrains
6319 ! if (tor_mode.ne.2) then
6322 end subroutine ebend
6325 !-----------------------------------------------------------------------------
6326 subroutine esc(escloc)
6327 ! Calculate the local energy of a side chain and its derivatives in the
6328 ! corresponding virtual-bond valence angles THETA and the spherical angles
6332 ! implicit real*8 (a-h,o-z)
6333 ! include 'DIMENSIONS'
6334 ! include 'COMMON.GEO'
6335 ! include 'COMMON.LOCAL'
6336 ! include 'COMMON.VAR'
6337 ! include 'COMMON.INTERACT'
6338 ! include 'COMMON.DERIV'
6339 ! include 'COMMON.CHAIN'
6340 ! include 'COMMON.IOUNITS'
6341 ! include 'COMMON.NAMES'
6342 ! include 'COMMON.FFIELD'
6343 ! include 'COMMON.CONTROL'
6344 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
6345 ddersc0,ddummy,xtemp,temp
6346 !el real(kind=8) :: time11,time12,time112,theti
6347 real(kind=8) :: escloc,delta
6348 !el integer :: it,nlobit
6349 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6352 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
6353 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
6356 ! write (iout,'(a)') 'ESC'
6357 do i=loc_start,loc_end
6359 if (it.eq.ntyp1) cycle
6360 if (it.eq.10) goto 1
6361 nlobit=nlob(iabs(it))
6362 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
6363 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6364 theti=theta(i+1)-pipol
6369 if (x(2).gt.pi-delta) then
6373 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6375 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6376 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
6378 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
6379 ddersc0(1),dersc(1))
6380 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
6381 ddersc0(3),dersc(3))
6383 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6385 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6386 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
6387 dersc0(2),esclocbi,dersc02)
6388 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
6390 call splinthet(x(2),0.5d0*delta,ss,ssd)
6395 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6397 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6398 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6400 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6402 ! write (iout,*) escloci
6403 else if (x(2).lt.delta) then
6407 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6409 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6410 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
6412 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6413 ddersc0(1),dersc(1))
6414 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
6415 ddersc0(3),dersc(3))
6417 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6419 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6420 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
6421 dersc0(2),esclocbi,dersc02)
6422 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6427 call splinthet(x(2),0.5d0*delta,ss,ssd)
6429 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6431 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6432 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6434 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6435 ! write (iout,*) escloci
6437 call enesc(x,escloci,dersc,ddummy,.false.)
6440 escloc=escloc+escloci
6441 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6443 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6445 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
6447 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6448 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6453 !-----------------------------------------------------------------------------
6454 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6457 ! implicit real*8 (a-h,o-z)
6458 ! include 'DIMENSIONS'
6459 ! include 'COMMON.GEO'
6460 ! include 'COMMON.LOCAL'
6461 ! include 'COMMON.IOUNITS'
6462 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6463 real(kind=8),dimension(3) :: x,z,dersc,ddersc
6464 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
6465 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
6466 real(kind=8) :: escloci
6469 integer :: j,iii,l,k !el,it,nlobit
6470 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
6471 !el time11,time12,time112
6472 ! write (iout,*) 'it=',it,' nlobit=',nlobit
6476 if (mixed) ddersc(j)=0.0d0
6480 ! Because of periodicity of the dependence of the SC energy in omega we have
6481 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6482 ! To avoid underflows, first compute & store the exponents.
6490 z(k)=x(k)-censc(k,j,it)
6495 Axk=Axk+gaussc(l,k,j,it)*z(l)
6501 expfac=expfac+Ax(k,j,iii)*z(k)
6509 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6510 ! subsequent NaNs and INFs in energy calculation.
6511 ! Find the largest exponent
6515 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6519 !d print *,'it=',it,' emin=',emin
6521 ! Compute the contribution to SC energy and derivatives
6526 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6527 if(adexp.ne.adexp) adexp=1.0
6530 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6532 !d print *,'j=',j,' expfac=',expfac
6533 escloc_i=escloc_i+expfac
6535 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6539 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
6540 +gaussc(k,2,j,it))*expfac
6547 dersc(1)=dersc(1)/cos(theti)**2
6548 ddersc(1)=ddersc(1)/cos(theti)**2
6551 escloci=-(dlog(escloc_i)-emin)
6553 dersc(j)=dersc(j)/escloc_i
6557 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6561 end subroutine enesc
6562 !-----------------------------------------------------------------------------
6563 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6566 ! implicit real*8 (a-h,o-z)
6567 ! include 'DIMENSIONS'
6568 ! include 'COMMON.GEO'
6569 ! include 'COMMON.LOCAL'
6570 ! include 'COMMON.IOUNITS'
6571 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6572 real(kind=8),dimension(3) :: x,z,dersc
6573 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
6574 real(kind=8),dimension(nlobit) :: contr !(maxlob)
6575 real(kind=8) :: escloci,dersc12,emin
6578 integer :: j,k,l !el,it,nlobit
6579 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
6589 z(k)=x(k)-censc(k,j,it)
6595 Axk=Axk+gaussc(l,k,j,it)*z(l)
6601 expfac=expfac+Ax(k,j)*z(k)
6606 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6607 ! subsequent NaNs and INFs in energy calculation.
6608 ! Find the largest exponent
6611 if (emin.gt.contr(j)) emin=contr(j)
6615 ! Compute the contribution to SC energy and derivatives
6619 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6620 escloc_i=escloc_i+expfac
6622 dersc(k)=dersc(k)+Ax(k,j)*expfac
6624 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
6625 +gaussc(1,2,j,it))*expfac
6629 dersc(1)=dersc(1)/cos(theti)**2
6630 dersc12=dersc12/cos(theti)**2
6631 escloci=-(dlog(escloc_i)-emin)
6633 dersc(j)=dersc(j)/escloc_i
6635 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6637 end subroutine enesc_bound
6639 !-----------------------------------------------------------------------------
6640 subroutine esc(escloc)
6641 ! Calculate the local energy of a side chain and its derivatives in the
6642 ! corresponding virtual-bond valence angles THETA and the spherical angles
6643 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
6644 ! added by Urszula Kozlowska. 07/11/2007
6647 ! implicit real*8 (a-h,o-z)
6648 ! include 'DIMENSIONS'
6649 ! include 'COMMON.GEO'
6650 ! include 'COMMON.LOCAL'
6651 ! include 'COMMON.VAR'
6652 ! include 'COMMON.SCROT'
6653 ! include 'COMMON.INTERACT'
6654 ! include 'COMMON.DERIV'
6655 ! include 'COMMON.CHAIN'
6656 ! include 'COMMON.IOUNITS'
6657 ! include 'COMMON.NAMES'
6658 ! include 'COMMON.FFIELD'
6659 ! include 'COMMON.CONTROL'
6660 ! include 'COMMON.VECTORS'
6661 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6662 real(kind=8),dimension(65) :: x
6663 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6664 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6665 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6666 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6667 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6669 integer :: i,j,k !el,it,nlobit
6670 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6671 !el real(kind=8) :: time11,time12,time112,theti
6672 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6673 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6674 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6675 sumene1x,sumene2x,sumene3x,sumene4x,&
6676 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6679 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6680 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6683 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6687 do i=loc_start,loc_end
6688 if (itype(i,1).eq.ntyp1) cycle
6689 costtab(i+1) =dcos(theta(i+1))
6690 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6691 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6692 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6693 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6694 cosfac=dsqrt(cosfac2)
6695 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6696 sinfac=dsqrt(sinfac2)
6698 if (it.eq.10) goto 1
6700 ! Compute the axes of tghe local cartesian coordinates system; store in
6701 ! x_prime, y_prime and z_prime
6708 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6709 ! & dc_norm(3,i+nres)
6711 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6712 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6715 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6718 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6719 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6720 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6721 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6722 ! & " xy",scalar(x_prime(1),y_prime(1)),
6723 ! & " xz",scalar(x_prime(1),z_prime(1)),
6724 ! & " yy",scalar(y_prime(1),y_prime(1)),
6725 ! & " yz",scalar(y_prime(1),z_prime(1)),
6726 ! & " zz",scalar(z_prime(1),z_prime(1))
6728 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6729 ! to local coordinate system. Store in xx, yy, zz.
6735 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6736 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6737 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6744 ! Compute the energy of the ith side cbain
6746 ! write (2,*) "xx",xx," yy",yy," zz",zz
6749 x(j) = sc_parmin(j,it)
6752 !c diagnostics - remove later
6754 yy1 = dsin(alph(2))*dcos(omeg(2))
6755 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6756 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6757 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6759 !," --- ", xx_w,yy_w,zz_w
6762 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6763 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6765 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6766 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6768 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6769 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6770 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6771 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6772 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6774 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6775 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6776 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6777 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6778 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6780 dsc_i = 0.743d0+x(61)
6782 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6783 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6784 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6785 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6786 s1=(1+x(63))/(0.1d0 + dscp1)
6787 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6788 s2=(1+x(65))/(0.1d0 + dscp2)
6789 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6790 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6791 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6792 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6794 ! & dscp1,dscp2,sumene
6795 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6796 escloc = escloc + sumene
6797 if (energy_dec) write (2,*) "i",i," itype",itype(i,1)," it",it, &
6798 " escloc",sumene,escloc,it,itype(i,1)
6799 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6804 ! This section to check the numerical derivatives of the energy of ith side
6805 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6806 ! #define DEBUG in the code to turn it on.
6808 write (2,*) "sumene =",sumene
6812 write (2,*) xx,yy,zz
6813 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6814 de_dxx_num=(sumenep-sumene)/aincr
6816 write (2,*) "xx+ sumene from enesc=",sumenep
6819 write (2,*) xx,yy,zz
6820 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6821 de_dyy_num=(sumenep-sumene)/aincr
6823 write (2,*) "yy+ sumene from enesc=",sumenep
6826 write (2,*) xx,yy,zz
6827 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6828 de_dzz_num=(sumenep-sumene)/aincr
6830 write (2,*) "zz+ sumene from enesc=",sumenep
6831 costsave=cost2tab(i+1)
6832 sintsave=sint2tab(i+1)
6833 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6834 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6835 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6836 de_dt_num=(sumenep-sumene)/aincr
6837 write (2,*) " t+ sumene from enesc=",sumenep
6838 cost2tab(i+1)=costsave
6839 sint2tab(i+1)=sintsave
6840 ! End of diagnostics section.
6843 ! Compute the gradient of esc
6845 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6846 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6847 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6848 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6849 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6850 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6851 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6852 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6853 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6854 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6855 *(pom_s1/dscp1+pom_s16*dscp1**4)
6856 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6857 *(pom_s2/dscp2+pom_s26*dscp2**4)
6858 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6859 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6860 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6862 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6863 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6864 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6866 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6867 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6870 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6873 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6874 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6875 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6877 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6878 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6879 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6880 +x(59)*zz**2 +x(60)*xx*zz
6881 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6882 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6885 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
6888 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6889 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6890 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6891 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6892 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6893 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6894 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6895 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6897 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
6900 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6901 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6902 +pom1*pom_dt1+pom2*pom_dt2
6904 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
6908 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6909 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6910 cosfac2xx=cosfac2*xx
6911 sinfac2yy=sinfac2*yy
6913 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6915 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6917 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6918 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6919 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6920 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6921 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6922 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6923 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6924 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6925 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6926 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6930 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6931 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6932 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6933 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6936 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6937 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6938 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6939 (z_prime(k)-zz*dC_norm(k,i+nres))
6941 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6942 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6946 dXX_Ctab(k,i)=dXX_Ci(k)
6947 dXX_C1tab(k,i)=dXX_Ci1(k)
6948 dYY_Ctab(k,i)=dYY_Ci(k)
6949 dYY_C1tab(k,i)=dYY_Ci1(k)
6950 dZZ_Ctab(k,i)=dZZ_Ci(k)
6951 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6952 dXX_XYZtab(k,i)=dXX_XYZ(k)
6953 dYY_XYZtab(k,i)=dYY_XYZ(k)
6954 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6958 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6959 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6960 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6961 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6962 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6964 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6965 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6966 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6967 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6968 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6969 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6970 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6971 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6973 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6974 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6976 ! to check gradient call subroutine check_grad
6982 !-----------------------------------------------------------------------------
6983 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6985 real(kind=8),dimension(65) :: x
6986 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6987 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6989 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6990 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6992 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6993 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6995 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6996 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6997 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6998 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6999 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
7001 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
7002 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
7003 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
7004 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
7005 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
7007 dsc_i = 0.743d0+x(61)
7009 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
7010 *(xx*cost2+yy*sint2))
7011 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
7012 *(xx*cost2-yy*sint2))
7013 s1=(1+x(63))/(0.1d0 + dscp1)
7014 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7015 s2=(1+x(65))/(0.1d0 + dscp2)
7016 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7017 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
7018 + (sumene4*cost2 +sumene2)*(s2+s2_6)
7023 !-----------------------------------------------------------------------------
7024 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7026 ! This procedure calculates two-body contact function g(rij) and its derivative:
7029 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7032 ! where x=(rij-r0ij)/delta
7034 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7037 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
7038 real(kind=8) :: x,x2,x4,delta
7042 if (x.lt.-1.0D0) then
7045 else if (x.le.1.0D0) then
7048 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7049 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7055 end subroutine gcont
7056 !-----------------------------------------------------------------------------
7057 subroutine splinthet(theti,delta,ss,ssder)
7058 ! implicit real*8 (a-h,o-z)
7059 ! include 'DIMENSIONS'
7060 ! include 'COMMON.VAR'
7061 ! include 'COMMON.GEO'
7062 real(kind=8) :: theti,delta,ss,ssder
7063 real(kind=8) :: thetup,thetlow
7066 if (theti.gt.pipol) then
7067 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7069 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7073 end subroutine splinthet
7074 !-----------------------------------------------------------------------------
7075 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7077 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
7078 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
7079 a1=fprim0*delta/(f1-f0)
7085 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7086 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7088 end subroutine spline1
7089 !-----------------------------------------------------------------------------
7090 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7092 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
7093 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
7098 a2=3*(f1x-f0x)-2*fprim0x*delta
7099 a3=fprim0x*delta-2*(f1x-f0x)
7100 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7102 end subroutine spline2
7103 !-----------------------------------------------------------------------------
7105 !-----------------------------------------------------------------------------
7106 subroutine etor(etors,edihcnstr)
7107 ! implicit real*8 (a-h,o-z)
7108 ! include 'DIMENSIONS'
7109 ! include 'COMMON.VAR'
7110 ! include 'COMMON.GEO'
7111 ! include 'COMMON.LOCAL'
7112 ! include 'COMMON.TORSION'
7113 ! include 'COMMON.INTERACT'
7114 ! include 'COMMON.DERIV'
7115 ! include 'COMMON.CHAIN'
7116 ! include 'COMMON.NAMES'
7117 ! include 'COMMON.IOUNITS'
7118 ! include 'COMMON.FFIELD'
7119 ! include 'COMMON.TORCNSTR'
7120 ! include 'COMMON.CONTROL'
7121 real(kind=8) :: etors,edihcnstr
7125 real(kind=8) :: phii,fac,etors_ii
7127 ! Set lprn=.true. for debugging
7131 do i=iphi_start,iphi_end
7133 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
7134 .or. itype(i,1).eq.ntyp1) cycle
7135 itori=itortyp(itype(i-2,1))
7136 itori1=itortyp(itype(i-1,1))
7139 ! Proline-Proline pair is a special case...
7140 if (itori.eq.3 .and. itori1.eq.3) then
7141 if (phii.gt.-dwapi3) then
7143 fac=1.0D0/(1.0D0-cosphi)
7144 etorsi=v1(1,3,3)*fac
7145 etorsi=etorsi+etorsi
7146 etors=etors+etorsi-v1(1,3,3)
7147 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7148 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7151 v1ij=v1(j+1,itori,itori1)
7152 v2ij=v2(j+1,itori,itori1)
7155 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7156 if (energy_dec) etors_ii=etors_ii+ &
7157 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7158 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7162 v1ij=v1(j,itori,itori1)
7163 v2ij=v2(j,itori,itori1)
7166 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7167 if (energy_dec) etors_ii=etors_ii+ &
7168 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7169 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7172 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7175 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7176 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
7177 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7178 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7179 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7181 ! 6/20/98 - dihedral angle constraints
7184 itori=idih_constr(i)
7187 if (difi.gt.drange(i)) then
7189 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7190 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7191 else if (difi.lt.-drange(i)) then
7193 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7194 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7196 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7197 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7199 ! write (iout,*) 'edihcnstr',edihcnstr
7202 !-----------------------------------------------------------------------------
7203 subroutine etor_d(etors_d)
7204 real(kind=8) :: etors_d
7207 end subroutine etor_d
7209 !-----------------------------------------------------------------------------
7210 subroutine etor(etors)
7211 ! implicit real*8 (a-h,o-z)
7212 ! include 'DIMENSIONS'
7213 ! include 'COMMON.VAR'
7214 ! include 'COMMON.GEO'
7215 ! include 'COMMON.LOCAL'
7216 ! include 'COMMON.TORSION'
7217 ! include 'COMMON.INTERACT'
7218 ! include 'COMMON.DERIV'
7219 ! include 'COMMON.CHAIN'
7220 ! include 'COMMON.NAMES'
7221 ! include 'COMMON.IOUNITS'
7222 ! include 'COMMON.FFIELD'
7223 ! include 'COMMON.TORCNSTR'
7224 ! include 'COMMON.CONTROL'
7225 real(kind=8) :: etors,edihcnstr
7228 integer :: i,j,iblock,itori,itori1
7229 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
7230 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
7231 ! Set lprn=.true. for debugging
7235 do i=iphi_start,iphi_end
7236 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
7237 .or. itype(i-3,1).eq.ntyp1 &
7238 .or. itype(i,1).eq.ntyp1) cycle
7240 if (iabs(itype(i,1)).eq.20) then
7245 itori=itortyp(itype(i-2,1))
7246 itori1=itortyp(itype(i-1,1))
7249 ! Regular cosine and sine terms
7250 do j=1,nterm(itori,itori1,iblock)
7251 v1ij=v1(j,itori,itori1,iblock)
7252 v2ij=v2(j,itori,itori1,iblock)
7255 etors=etors+v1ij*cosphi+v2ij*sinphi
7256 if (energy_dec) etors_ii=etors_ii+ &
7257 v1ij*cosphi+v2ij*sinphi
7258 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7262 ! E = SUM ----------------------------------- - v1
7263 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7265 cosphi=dcos(0.5d0*phii)
7266 sinphi=dsin(0.5d0*phii)
7267 do j=1,nlor(itori,itori1,iblock)
7268 vl1ij=vlor1(j,itori,itori1)
7269 vl2ij=vlor2(j,itori,itori1)
7270 vl3ij=vlor3(j,itori,itori1)
7271 pom=vl2ij*cosphi+vl3ij*sinphi
7272 pom1=1.0d0/(pom*pom+1.0d0)
7273 etors=etors+vl1ij*pom1
7274 if (energy_dec) etors_ii=etors_ii+ &
7277 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7279 ! Subtract the constant term
7280 etors=etors-v0(itori,itori1,iblock)
7281 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7282 'etor',i,etors_ii-v0(itori,itori1,iblock)
7284 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7285 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
7286 (v1(j,itori,itori1,iblock),j=1,6),&
7287 (v2(j,itori,itori1,iblock),j=1,6)
7288 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7289 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7291 ! 6/20/98 - dihedral angle constraints
7294 !C The rigorous attempt to derive energy function
7295 !-------------------------------------------------------------------------------------------
7296 subroutine etor_kcc(etors)
7297 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
7298 real(kind=8) :: etors,glocig,glocit1,glocit2,sinthet1,&
7299 sinthet2,costhet1,costhet2,sint1t2,sint1t2n,phii,sinphi,cosphi,&
7300 sint1t2n1,sumvalc,gradvalct1,gradvalct2,sumvals,gradvalst1,&
7303 integer :: i,j,itori,itori1,nval,k,l
7305 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7307 do i=iphi_start,iphi_end
7308 !C ANY TWO ARE DUMMY ATOMS in row CYCLE
7309 !c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7310 !c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7311 !c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7312 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
7313 .or. itype(i,1).eq.ntyp1 .or. itype(i-3,1).eq.ntyp1) cycle
7314 itori=itortyp(itype(i-2,1))
7315 itori1=itortyp(itype(i-1,1))
7320 !C to avoid multiple devision by 2
7321 !c theti22=0.5d0*theta(i)
7322 !C theta 12 is the theta_1 /2
7323 !C theta 22 is theta_2 /2
7324 !c theti12=0.5d0*theta(i-1)
7325 !C and appropriate sinus function
7326 sinthet1=dsin(theta(i-1))
7327 sinthet2=dsin(theta(i))
7328 costhet1=dcos(theta(i-1))
7329 costhet2=dcos(theta(i))
7330 !C to speed up lets store its mutliplication
7331 sint1t2=sinthet2*sinthet1
7333 !C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7334 !C +d_n*sin(n*gamma)) *
7335 !C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7336 !C we have two sum 1) Non-Chebyshev which is with n and gamma
7337 nval=nterm_kcc_Tb(itori,itori1)
7343 c1(j)=c1(j-1)*costhet1
7344 c2(j)=c2(j-1)*costhet2
7348 do j=1,nterm_kcc(itori,itori1)
7352 sint1t2n=sint1t2n*sint1t2
7358 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7359 gradvalct1=gradvalct1+ &
7360 (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7361 gradvalct2=gradvalct2+ &
7362 (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7365 gradvalct1=-gradvalct1*sinthet1
7366 gradvalct2=-gradvalct2*sinthet2
7372 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7373 gradvalst1=gradvalst1+ &
7374 (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7375 gradvalst2=gradvalst2+ &
7376 (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7379 gradvalst1=-gradvalst1*sinthet1
7380 gradvalst2=-gradvalst2*sinthet2
7381 if (lprn) write (iout,*)j,"sumvalc",sumvalc," sumvals",sumvals
7382 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
7383 !C glocig is the gradient local i site in gamma
7384 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
7385 !C now gradient over theta_1
7386 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)&
7387 +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
7388 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)&
7389 +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
7392 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7393 !C derivative over theta1
7394 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
7395 !C now derivative over theta2
7396 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
7398 write (iout,*) i-2,i-1,itype(i-2,1),itype(i-1,1),itori,itori1,&
7399 theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
7400 write (iout,*) "c1",(c1(k),k=0,nval), &
7401 " c2",(c2(k),k=0,nval)
7405 end subroutine etor_kcc
7406 !------------------------------------------------------------------------------
7408 subroutine etor_constr(edihcnstr)
7409 real(kind=8) :: etors,edihcnstr
7412 integer :: i,j,iblock,itori,itori1
7413 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
7414 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom,&
7415 gaudih_i,gauder_i,s,cos_i,dexpcos_i
7417 if (raw_psipred) then
7418 do i=idihconstr_start,idihconstr_end
7419 itori=idih_constr(i)
7421 gaudih_i=vpsipred(1,i)
7425 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
7426 dexpcos_i=dexp(-cos_i*cos_i)
7427 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
7428 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i)) &
7429 *cos_i*dexpcos_i/s**2
7431 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
7432 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
7434 write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)') &
7435 i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),&
7436 phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),&
7437 phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,&
7438 -wdihc*dlog(gaudih_i)
7442 do i=idihconstr_start,idihconstr_end
7443 itori=idih_constr(i)
7445 difi=pinorm(phii-phi0(i))
7446 if (difi.gt.drange(i)) then
7448 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7449 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7450 else if (difi.lt.-drange(i)) then
7452 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7453 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7463 end subroutine etor_constr
7464 !-----------------------------------------------------------------------------
7465 subroutine etor_d(etors_d)
7466 ! 6/23/01 Compute double torsional energy
7467 ! implicit real*8 (a-h,o-z)
7468 ! include 'DIMENSIONS'
7469 ! include 'COMMON.VAR'
7470 ! include 'COMMON.GEO'
7471 ! include 'COMMON.LOCAL'
7472 ! include 'COMMON.TORSION'
7473 ! include 'COMMON.INTERACT'
7474 ! include 'COMMON.DERIV'
7475 ! include 'COMMON.CHAIN'
7476 ! include 'COMMON.NAMES'
7477 ! include 'COMMON.IOUNITS'
7478 ! include 'COMMON.FFIELD'
7479 ! include 'COMMON.TORCNSTR'
7480 real(kind=8) :: etors_d,etors_d_ii
7483 integer :: i,j,k,l,itori,itori1,itori2,iblock
7484 real(kind=8) :: phii,phii1,gloci1,gloci2,&
7485 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
7486 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
7487 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
7488 ! Set lprn=.true. for debugging
7492 ! write(iout,*) "a tu??"
7493 do i=iphid_start,iphid_end
7495 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
7496 .or. itype(i-3,1).eq.ntyp1 &
7497 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
7498 itori=itortyp(itype(i-2,1))
7499 itori1=itortyp(itype(i-1,1))
7500 itori2=itortyp(itype(i,1))
7506 if (iabs(itype(i+1,1)).eq.20) iblock=2
7508 ! Regular cosine and sine terms
7509 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7510 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7511 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7512 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7513 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7514 cosphi1=dcos(j*phii)
7515 sinphi1=dsin(j*phii)
7516 cosphi2=dcos(j*phii1)
7517 sinphi2=dsin(j*phii1)
7518 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
7519 v2cij*cosphi2+v2sij*sinphi2
7520 if (energy_dec) etors_d_ii=etors_d_ii+ &
7521 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
7522 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7523 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7525 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7527 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7528 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7529 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7530 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7531 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7532 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7533 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7534 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7535 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
7536 v1sdij*sinphi1p2+v2sdij*sinphi1m2
7537 if (energy_dec) etors_d_ii=etors_d_ii+ &
7538 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
7539 v1sdij*sinphi1p2+v2sdij*sinphi1m2
7540 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
7541 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7542 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
7543 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7546 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7547 'etor_d',i,etors_d_ii
7548 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7549 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7552 end subroutine etor_d
7555 subroutine ebend_kcc(etheta)
7557 double precision thybt1(maxang_kcc),etheta
7558 integer :: i,iti,j,ihelp
7559 real (kind=8) :: sinthet,costhet,sumth1thyb,gradthybt1
7560 !C Set lprn=.true. for debugging
7563 !C print *,"wchodze kcc"
7564 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
7566 do i=ithet_start,ithet_end
7567 !c print *,i,itype(i-1),itype(i),itype(i-2)
7568 if ((itype(i-1,1).eq.ntyp1).or.itype(i-2,1).eq.ntyp1 &
7569 .or.itype(i,1).eq.ntyp1) cycle
7570 iti=iabs(itortyp(itype(i-1,1)))
7571 sinthet=dsin(theta(i))
7572 costhet=dcos(theta(i))
7573 do j=1,nbend_kcc_Tb(iti)
7574 thybt1(j)=v1bend_chyb(j,iti)
7576 sumth1thyb=v1bend_chyb(0,iti)+ &
7577 tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7578 if (lprn) write (iout,*) i-1,itype(i-1,1),iti,theta(i)*rad2deg,&
7580 ihelp=nbend_kcc_Tb(iti)-1
7581 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
7582 etheta=etheta+sumth1thyb
7583 !C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7584 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
7587 end subroutine ebend_kcc
7589 !c-------------------------------------------------------------------------------------
7590 subroutine etheta_constr(ethetacnstr)
7591 real (kind=8) :: ethetacnstr,thetiii,difi
7594 !C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7595 do i=ithetaconstr_start,ithetaconstr_end
7596 itheta=itheta_constr(i)
7597 thetiii=theta(itheta)
7598 difi=pinorm(thetiii-theta_constr0(i))
7599 if (difi.gt.theta_drange(i)) then
7600 difi=difi-theta_drange(i)
7601 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7602 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
7603 +for_thet_constr(i)*difi**3
7604 else if (difi.lt.-drange(i)) then
7606 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7607 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
7608 +for_thet_constr(i)*difi**3
7612 if (energy_dec) then
7613 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",&
7614 i,itheta,rad2deg*thetiii,&
7615 rad2deg*theta_constr0(i), rad2deg*theta_drange(i),&
7616 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,&
7617 gloc(itheta+nphi-2,icg)
7621 end subroutine etheta_constr
7623 !-----------------------------------------------------------------------------
7624 subroutine eback_sc_corr(esccor)
7625 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
7626 ! conformational states; temporarily implemented as differences
7627 ! between UNRES torsional potentials (dependent on three types of
7628 ! residues) and the torsional potentials dependent on all 20 types
7629 ! of residues computed from AM1 energy surfaces of terminally-blocked
7630 ! amino-acid residues.
7631 ! implicit real*8 (a-h,o-z)
7632 ! include 'DIMENSIONS'
7633 ! include 'COMMON.VAR'
7634 ! include 'COMMON.GEO'
7635 ! include 'COMMON.LOCAL'
7636 ! include 'COMMON.TORSION'
7637 ! include 'COMMON.SCCOR'
7638 ! include 'COMMON.INTERACT'
7639 ! include 'COMMON.DERIV'
7640 ! include 'COMMON.CHAIN'
7641 ! include 'COMMON.NAMES'
7642 ! include 'COMMON.IOUNITS'
7643 ! include 'COMMON.FFIELD'
7644 ! include 'COMMON.CONTROL'
7645 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
7648 integer :: i,interty,j,isccori,isccori1,intertyp
7649 ! Set lprn=.true. for debugging
7652 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7654 do i=itau_start,itau_end
7655 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
7657 isccori=isccortyp(itype(i-2,1))
7658 isccori1=isccortyp(itype(i-1,1))
7660 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7662 do intertyp=1,3 !intertyp
7664 !c Added 09 May 2012 (Adasko)
7665 !c Intertyp means interaction type of backbone mainchain correlation:
7666 ! 1 = SC...Ca...Ca...Ca
7667 ! 2 = Ca...Ca...Ca...SC
7668 ! 3 = SC...Ca...Ca...SCi
7670 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
7671 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
7672 (itype(i-1,1).eq.ntyp1))) &
7673 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
7674 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
7675 .or.(itype(i,1).eq.ntyp1))) &
7676 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
7677 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
7678 (itype(i-3,1).eq.ntyp1)))) cycle
7679 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
7680 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
7682 do j=1,nterm_sccor(isccori,isccori1)
7683 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7684 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7685 cosphi=dcos(j*tauangle(intertyp,i))
7686 sinphi=dsin(j*tauangle(intertyp,i))
7687 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7688 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7689 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7691 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
7692 'esccor',i,intertyp,esccor_ii
7693 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7694 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7696 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7697 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
7698 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
7699 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7700 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7705 end subroutine eback_sc_corr
7706 !-----------------------------------------------------------------------------
7707 subroutine multibody(ecorr)
7708 ! This subroutine calculates multi-body contributions to energy following
7709 ! the idea of Skolnick et al. If side chains I and J make a contact and
7710 ! at the same time side chains I+1 and J+1 make a contact, an extra
7711 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7712 ! implicit real*8 (a-h,o-z)
7713 ! include 'DIMENSIONS'
7714 ! include 'COMMON.IOUNITS'
7715 ! include 'COMMON.DERIV'
7716 ! include 'COMMON.INTERACT'
7717 ! include 'COMMON.CONTACTS'
7718 real(kind=8),dimension(3) :: gx,gx1
7720 real(kind=8) :: ecorr
7721 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
7722 ! Set lprn=.true. for debugging
7726 write (iout,'(a)') 'Contact function values:'
7728 write (iout,'(i2,20(1x,i2,f10.5))') &
7729 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7734 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7735 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7747 num_conti=num_cont(i)
7748 num_conti1=num_cont(i1)
7753 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7754 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7755 !d & ' ishift=',ishift
7756 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7757 ! The system gains extra energy.
7758 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7759 endif ! j1==j+-ishift
7767 end subroutine multibody
7768 !-----------------------------------------------------------------------------
7769 real(kind=8) function esccorr(i,j,k,l,jj,kk)
7770 ! implicit real*8 (a-h,o-z)
7771 ! include 'DIMENSIONS'
7772 ! include 'COMMON.IOUNITS'
7773 ! include 'COMMON.DERIV'
7774 ! include 'COMMON.INTERACT'
7775 ! include 'COMMON.CONTACTS'
7776 real(kind=8),dimension(3) :: gx,gx1
7778 integer :: i,j,k,l,jj,kk,m,ll
7779 real(kind=8) :: eij,ekl
7783 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7784 ! Calculate the multi-body contribution to energy.
7785 ! Calculate multi-body contributions to the gradient.
7786 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7787 !d & k,l,(gacont(m,kk,k),m=1,3)
7789 gx(m) =ekl*gacont(m,jj,i)
7790 gx1(m)=eij*gacont(m,kk,k)
7791 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7792 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7793 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7794 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7798 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7803 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7808 end function esccorr
7809 !-----------------------------------------------------------------------------
7810 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7811 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7812 ! implicit real*8 (a-h,o-z)
7813 ! include 'DIMENSIONS'
7814 ! include 'COMMON.IOUNITS'
7817 ! integer :: maxconts !max_cont=maxconts =nres/4
7818 integer,parameter :: max_dim=26
7819 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7820 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7821 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7822 !el common /przechowalnia/ zapas
7823 integer :: status(MPI_STATUS_SIZE)
7824 integer,dimension((nres/4)*2) :: req !maxconts*2
7825 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
7827 ! include 'COMMON.SETUP'
7828 ! include 'COMMON.FFIELD'
7829 ! include 'COMMON.DERIV'
7830 ! include 'COMMON.INTERACT'
7831 ! include 'COMMON.CONTACTS'
7832 ! include 'COMMON.CONTROL'
7833 ! include 'COMMON.LOCAL'
7834 real(kind=8),dimension(3) :: gx,gx1
7835 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
7836 logical :: lprn,ldone
7838 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
7839 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
7841 ! Set lprn=.true. for debugging
7845 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7848 if (nfgtasks.le.1) goto 30
7850 write (iout,'(a)') 'Contact function values before RECEIVE:'
7852 write (iout,'(2i3,50(1x,i2,f5.2))') &
7853 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7858 do i=1,ntask_cont_from
7861 do i=1,ntask_cont_to
7864 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7866 ! Make the list of contacts to send to send to other procesors
7867 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7869 do i=iturn3_start,iturn3_end
7870 ! write (iout,*) "make contact list turn3",i," num_cont",
7872 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7874 do i=iturn4_start,iturn4_end
7875 ! write (iout,*) "make contact list turn4",i," num_cont",
7877 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7881 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7883 do j=1,num_cont_hb(i)
7886 iproc=iint_sent_local(k,jjc,ii)
7887 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7888 if (iproc.gt.0) then
7889 ncont_sent(iproc)=ncont_sent(iproc)+1
7890 nn=ncont_sent(iproc)
7892 zapas(2,nn,iproc)=jjc
7893 zapas(3,nn,iproc)=facont_hb(j,i)
7894 zapas(4,nn,iproc)=ees0p(j,i)
7895 zapas(5,nn,iproc)=ees0m(j,i)
7896 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7897 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7898 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7899 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7900 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7901 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7902 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7903 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7904 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7905 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7906 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7907 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7908 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7909 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7910 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7911 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7912 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7913 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7914 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7915 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7916 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7923 "Numbers of contacts to be sent to other processors",&
7924 (ncont_sent(i),i=1,ntask_cont_to)
7925 write (iout,*) "Contacts sent"
7926 do ii=1,ntask_cont_to
7928 iproc=itask_cont_to(ii)
7929 write (iout,*) nn," contacts to processor",iproc,&
7930 " of CONT_TO_COMM group"
7932 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7940 CorrelID1=nfgtasks+fg_rank+1
7942 ! Receive the numbers of needed contacts from other processors
7943 do ii=1,ntask_cont_from
7944 iproc=itask_cont_from(ii)
7946 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7947 FG_COMM,req(ireq),IERR)
7949 ! write (iout,*) "IRECV ended"
7951 ! Send the number of contacts needed by other processors
7952 do ii=1,ntask_cont_to
7953 iproc=itask_cont_to(ii)
7955 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7956 FG_COMM,req(ireq),IERR)
7958 ! write (iout,*) "ISEND ended"
7959 ! write (iout,*) "number of requests (nn)",ireq
7962 call MPI_Waitall(ireq,req,status_array,ierr)
7964 ! & "Numbers of contacts to be received from other processors",
7965 ! & (ncont_recv(i),i=1,ntask_cont_from)
7969 do ii=1,ntask_cont_from
7970 iproc=itask_cont_from(ii)
7972 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7973 ! & " of CONT_TO_COMM group"
7977 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7978 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7979 ! write (iout,*) "ireq,req",ireq,req(ireq)
7982 ! Send the contacts to processors that need them
7983 do ii=1,ntask_cont_to
7984 iproc=itask_cont_to(ii)
7986 ! write (iout,*) nn," contacts to processor",iproc,
7987 ! & " of CONT_TO_COMM group"
7990 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7991 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7992 ! write (iout,*) "ireq,req",ireq,req(ireq)
7994 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7998 ! write (iout,*) "number of requests (contacts)",ireq
7999 ! write (iout,*) "req",(req(i),i=1,4)
8002 call MPI_Waitall(ireq,req,status_array,ierr)
8003 do iii=1,ntask_cont_from
8004 iproc=itask_cont_from(iii)
8007 write (iout,*) "Received",nn," contacts from processor",iproc,&
8008 " of CONT_FROM_COMM group"
8011 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8016 ii=zapas_recv(1,i,iii)
8017 ! Flag the received contacts to prevent double-counting
8018 jj=-zapas_recv(2,i,iii)
8019 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8021 nnn=num_cont_hb(ii)+1
8024 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8025 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8026 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8027 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8028 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8029 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8030 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8031 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8032 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8033 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8034 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8035 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8036 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8037 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8038 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8039 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8040 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8041 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8042 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8043 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8044 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8045 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8046 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8047 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8052 write (iout,'(a)') 'Contact function values after receive:'
8054 write (iout,'(2i3,50(1x,i3,f5.2))') &
8055 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
8063 write (iout,'(a)') 'Contact function values:'
8065 write (iout,'(2i3,50(1x,i3,f5.2))') &
8066 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
8072 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
8073 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
8074 ! Remove the loop below after debugging !!!
8081 ! Calculate the local-electrostatic correlation terms
8082 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8084 num_conti=num_cont_hb(i)
8085 num_conti1=num_cont_hb(i+1)
8092 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
8093 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
8094 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
8095 .or. j.lt.0 .and. j1.gt.0) .and. &
8096 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8097 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8098 ! The system gains extra energy.
8099 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8100 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
8101 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8103 else if (j1.eq.j) then
8104 ! Contacts I-J and I-(J+1) occur simultaneously.
8105 ! The system loses extra energy.
8106 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8111 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8112 ! & ' jj=',jj,' kk=',kk
8114 ! Contacts I-J and (I+1)-J occur simultaneously.
8115 ! The system loses extra energy.
8116 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8122 end subroutine multibody_hb
8123 !-----------------------------------------------------------------------------
8124 subroutine add_hb_contact(ii,jj,itask)
8125 ! implicit real*8 (a-h,o-z)
8126 ! include "DIMENSIONS"
8127 ! include "COMMON.IOUNITS"
8128 ! include "COMMON.CONTACTS"
8129 ! integer,parameter :: maxconts=nres/4
8130 integer,parameter :: max_dim=26
8131 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
8132 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
8133 ! common /przechowalnia/ zapas
8134 integer :: i,j,ii,jj,iproc,nn,jjc
8135 integer,dimension(4) :: itask
8136 ! write (iout,*) "itask",itask
8139 if (iproc.gt.0) then
8140 do j=1,num_cont_hb(ii)
8142 ! write (iout,*) "i",ii," j",jj," jjc",jjc
8144 ncont_sent(iproc)=ncont_sent(iproc)+1
8145 nn=ncont_sent(iproc)
8146 zapas(1,nn,iproc)=ii
8147 zapas(2,nn,iproc)=jjc
8148 zapas(3,nn,iproc)=facont_hb(j,ii)
8149 zapas(4,nn,iproc)=ees0p(j,ii)
8150 zapas(5,nn,iproc)=ees0m(j,ii)
8151 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8152 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8153 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8154 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8155 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8156 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8157 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8158 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8159 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8160 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8161 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8162 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8163 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8164 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8165 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8166 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8167 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8168 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8169 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8170 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8171 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8178 end subroutine add_hb_contact
8179 !-----------------------------------------------------------------------------
8180 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
8181 ! This subroutine calculates multi-body contributions to hydrogen-bonding
8182 ! implicit real*8 (a-h,o-z)
8183 ! include 'DIMENSIONS'
8184 ! include 'COMMON.IOUNITS'
8185 integer,parameter :: max_dim=70
8188 ! integer :: maxconts !max_cont=maxconts=nres/4
8189 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8190 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
8191 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
8192 ! common /przechowalnia/ zapas
8193 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
8194 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
8197 ! include 'COMMON.SETUP'
8198 ! include 'COMMON.FFIELD'
8199 ! include 'COMMON.DERIV'
8200 ! include 'COMMON.LOCAL'
8201 ! include 'COMMON.INTERACT'
8202 ! include 'COMMON.CONTACTS'
8203 ! include 'COMMON.CHAIN'
8204 ! include 'COMMON.CONTROL'
8205 real(kind=8),dimension(3) :: gx,gx1
8206 integer,dimension(nres) :: num_cont_hb_old
8207 logical :: lprn,ldone
8208 !EL double precision eello4,eello5,eelo6,eello_turn6
8209 !EL external eello4,eello5,eello6,eello_turn6
8211 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
8212 j1,jp1,i1,num_conti1
8213 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
8214 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
8216 ! Set lprn=.true. for debugging
8221 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
8223 num_cont_hb_old(i)=num_cont_hb(i)
8227 if (nfgtasks.le.1) goto 30
8229 write (iout,'(a)') 'Contact function values before RECEIVE:'
8231 write (iout,'(2i3,50(1x,i2,f5.2))') &
8232 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
8237 do i=1,ntask_cont_from
8240 do i=1,ntask_cont_to
8243 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8245 ! Make the list of contacts to send to send to other procesors
8246 do i=iturn3_start,iturn3_end
8247 ! write (iout,*) "make contact list turn3",i," num_cont",
8249 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8251 do i=iturn4_start,iturn4_end
8252 ! write (iout,*) "make contact list turn4",i," num_cont",
8254 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8258 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
8260 do j=1,num_cont_hb(i)
8263 iproc=iint_sent_local(k,jjc,ii)
8264 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8265 if (iproc.ne.0) then
8266 ncont_sent(iproc)=ncont_sent(iproc)+1
8267 nn=ncont_sent(iproc)
8269 zapas(2,nn,iproc)=jjc
8270 zapas(3,nn,iproc)=d_cont(j,i)
8274 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8279 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8287 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8298 "Numbers of contacts to be sent to other processors",&
8299 (ncont_sent(i),i=1,ntask_cont_to)
8300 write (iout,*) "Contacts sent"
8301 do ii=1,ntask_cont_to
8303 iproc=itask_cont_to(ii)
8304 write (iout,*) nn," contacts to processor",iproc,&
8305 " of CONT_TO_COMM group"
8307 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8315 CorrelID1=nfgtasks+fg_rank+1
8317 ! Receive the numbers of needed contacts from other processors
8318 do ii=1,ntask_cont_from
8319 iproc=itask_cont_from(ii)
8321 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
8322 FG_COMM,req(ireq),IERR)
8324 ! write (iout,*) "IRECV ended"
8326 ! Send the number of contacts needed by other processors
8327 do ii=1,ntask_cont_to
8328 iproc=itask_cont_to(ii)
8330 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
8331 FG_COMM,req(ireq),IERR)
8333 ! write (iout,*) "ISEND ended"
8334 ! write (iout,*) "number of requests (nn)",ireq
8337 call MPI_Waitall(ireq,req,status_array,ierr)
8339 ! & "Numbers of contacts to be received from other processors",
8340 ! & (ncont_recv(i),i=1,ntask_cont_from)
8344 do ii=1,ntask_cont_from
8345 iproc=itask_cont_from(ii)
8347 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
8348 ! & " of CONT_TO_COMM group"
8352 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
8353 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8354 ! write (iout,*) "ireq,req",ireq,req(ireq)
8357 ! Send the contacts to processors that need them
8358 do ii=1,ntask_cont_to
8359 iproc=itask_cont_to(ii)
8361 ! write (iout,*) nn," contacts to processor",iproc,
8362 ! & " of CONT_TO_COMM group"
8365 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
8366 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8367 ! write (iout,*) "ireq,req",ireq,req(ireq)
8369 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8373 ! write (iout,*) "number of requests (contacts)",ireq
8374 ! write (iout,*) "req",(req(i),i=1,4)
8377 call MPI_Waitall(ireq,req,status_array,ierr)
8378 do iii=1,ntask_cont_from
8379 iproc=itask_cont_from(iii)
8382 write (iout,*) "Received",nn," contacts from processor",iproc,&
8383 " of CONT_FROM_COMM group"
8386 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8391 ii=zapas_recv(1,i,iii)
8392 ! Flag the received contacts to prevent double-counting
8393 jj=-zapas_recv(2,i,iii)
8394 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8396 nnn=num_cont_hb(ii)+1
8399 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8403 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8408 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8416 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8425 write (iout,'(a)') 'Contact function values after receive:'
8427 write (iout,'(2i3,50(1x,i3,5f6.3))') &
8428 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
8429 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8436 write (iout,'(a)') 'Contact function values:'
8438 write (iout,'(2i3,50(1x,i2,5f6.3))') &
8439 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
8440 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8447 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
8448 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
8449 ! Remove the loop below after debugging !!!
8456 ! Calculate the dipole-dipole interaction energies
8457 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8458 do i=iatel_s,iatel_e+1
8459 num_conti=num_cont_hb(i)
8468 ! Calculate the local-electrostatic correlation terms
8469 ! write (iout,*) "gradcorr5 in eello5 before loop"
8471 ! write (iout,'(i5,3f10.5)')
8472 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8474 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8475 ! write (iout,*) "corr loop i",i
8477 num_conti=num_cont_hb(i)
8478 num_conti1=num_cont_hb(i+1)
8485 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8486 ! & ' jj=',jj,' kk=',kk
8487 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
8488 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
8489 .or. j.lt.0 .and. j1.gt.0) .and. &
8490 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8491 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8492 ! The system gains extra energy.
8494 sqd1=dsqrt(d_cont(jj,i))
8495 sqd2=dsqrt(d_cont(kk,i1))
8496 sred_geom = sqd1*sqd2
8497 IF (sred_geom.lt.cutoff_corr) THEN
8498 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
8500 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8501 !d & ' jj=',jj,' kk=',kk
8502 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8503 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8505 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8506 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8509 !d write (iout,*) 'sred_geom=',sred_geom,
8510 !d & ' ekont=',ekont,' fprim=',fprimcont,
8511 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8512 !d write (iout,*) "g_contij",g_contij
8513 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8514 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8515 call calc_eello(i,jp,i+1,jp1,jj,kk)
8516 if (wcorr4.gt.0.0d0) &
8517 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8518 if (energy_dec.and.wcorr4.gt.0.0d0) &
8519 write (iout,'(a6,4i5,0pf7.3)') &
8520 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8521 ! write (iout,*) "gradcorr5 before eello5"
8523 ! write (iout,'(i5,3f10.5)')
8524 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8526 if (wcorr5.gt.0.0d0) &
8527 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8528 ! write (iout,*) "gradcorr5 after eello5"
8530 ! write (iout,'(i5,3f10.5)')
8531 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8533 if (energy_dec.and.wcorr5.gt.0.0d0) &
8534 write (iout,'(a6,4i5,0pf7.3)') &
8535 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8536 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8537 !d write(2,*)'ijkl',i,jp,i+1,jp1
8538 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
8539 .or. wturn6.eq.0.0d0))then
8540 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8541 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8542 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
8543 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8544 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8545 !d & 'ecorr6=',ecorr6
8546 !d write (iout,'(4e15.5)') sred_geom,
8547 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8548 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8549 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8550 else if (wturn6.gt.0.0d0 &
8551 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8552 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8553 eturn6=eturn6+eello_turn6(i,jj,kk)
8554 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
8555 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8556 !d write (2,*) 'multibody_eello:eturn6',eturn6
8565 num_cont_hb(i)=num_cont_hb_old(i)
8567 ! write (iout,*) "gradcorr5 in eello5"
8569 ! write (iout,'(i5,3f10.5)')
8570 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8573 end subroutine multibody_eello
8574 !-----------------------------------------------------------------------------
8575 subroutine add_hb_contact_eello(ii,jj,itask)
8576 ! implicit real*8 (a-h,o-z)
8577 ! include "DIMENSIONS"
8578 ! include "COMMON.IOUNITS"
8579 ! include "COMMON.CONTACTS"
8580 ! integer,parameter :: maxconts=nres/4
8581 integer,parameter :: max_dim=70
8582 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
8583 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
8584 ! common /przechowalnia/ zapas
8586 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
8587 integer,dimension(4) ::itask
8588 ! write (iout,*) "itask",itask
8591 if (iproc.gt.0) then
8592 do j=1,num_cont_hb(ii)
8594 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8596 ncont_sent(iproc)=ncont_sent(iproc)+1
8597 nn=ncont_sent(iproc)
8598 zapas(1,nn,iproc)=ii
8599 zapas(2,nn,iproc)=jjc
8600 zapas(3,nn,iproc)=d_cont(j,ii)
8604 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8609 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8617 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8628 end subroutine add_hb_contact_eello
8629 !-----------------------------------------------------------------------------
8630 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8631 ! implicit real*8 (a-h,o-z)
8632 ! include 'DIMENSIONS'
8633 ! include 'COMMON.IOUNITS'
8634 ! include 'COMMON.DERIV'
8635 ! include 'COMMON.INTERACT'
8636 ! include 'COMMON.CONTACTS'
8637 real(kind=8),dimension(3) :: gx,gx1
8640 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
8641 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
8642 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
8643 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
8654 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8655 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8656 ! Following 4 lines for diagnostics.
8661 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8662 ! & 'Contacts ',i,j,
8663 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8664 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8666 ! Calculate the multi-body contribution to energy.
8667 ! ecorr=ecorr+ekont*ees
8668 ! Calculate multi-body contributions to the gradient.
8669 coeffpees0pij=coeffp*ees0pij
8670 coeffmees0mij=coeffm*ees0mij
8671 coeffpees0pkl=coeffp*ees0pkl
8672 coeffmees0mkl=coeffm*ees0mkl
8674 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8675 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
8676 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
8677 coeffmees0mkl*gacontm_hb1(ll,jj,i))
8678 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
8679 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
8680 coeffmees0mkl*gacontm_hb2(ll,jj,i))
8681 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8682 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
8683 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
8684 coeffmees0mij*gacontm_hb1(ll,kk,k))
8685 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
8686 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
8687 coeffmees0mij*gacontm_hb2(ll,kk,k))
8688 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
8689 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
8690 coeffmees0mkl*gacontm_hb3(ll,jj,i))
8691 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8692 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8693 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
8694 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
8695 coeffmees0mij*gacontm_hb3(ll,kk,k))
8696 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8697 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8698 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8703 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8704 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
8705 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8706 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8711 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8712 !grad & ees*eij*gacont_hbr(ll,kk,k)-
8713 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8714 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8717 ! write (iout,*) "ehbcorr",ekont*ees
8719 if (shield_mode.gt.0) then
8722 !C print *,i,j,fac_shield(i),fac_shield(j),
8723 !C &fac_shield(k),fac_shield(l)
8724 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
8725 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8726 do ilist=1,ishield_list(i)
8727 iresshield=shield_list(ilist,i)
8729 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8730 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8732 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8733 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8737 do ilist=1,ishield_list(j)
8738 iresshield=shield_list(ilist,j)
8740 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8741 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8743 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8744 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8749 do ilist=1,ishield_list(k)
8750 iresshield=shield_list(ilist,k)
8752 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8753 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8755 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8756 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8760 do ilist=1,ishield_list(l)
8761 iresshield=shield_list(ilist,l)
8763 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8764 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8766 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8767 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8772 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
8773 grad_shield(m,i)*ehbcorr/fac_shield(i)
8774 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
8775 grad_shield(m,j)*ehbcorr/fac_shield(j)
8776 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
8777 grad_shield(m,i)*ehbcorr/fac_shield(i)
8778 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
8779 grad_shield(m,j)*ehbcorr/fac_shield(j)
8781 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
8782 grad_shield(m,k)*ehbcorr/fac_shield(k)
8783 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
8784 grad_shield(m,l)*ehbcorr/fac_shield(l)
8785 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
8786 grad_shield(m,k)*ehbcorr/fac_shield(k)
8787 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
8788 grad_shield(m,l)*ehbcorr/fac_shield(l)
8794 end function ehbcorr
8796 !-----------------------------------------------------------------------------
8797 subroutine dipole(i,j,jj)
8798 ! implicit real*8 (a-h,o-z)
8799 ! include 'DIMENSIONS'
8800 ! include 'COMMON.IOUNITS'
8801 ! include 'COMMON.CHAIN'
8802 ! include 'COMMON.FFIELD'
8803 ! include 'COMMON.DERIV'
8804 ! include 'COMMON.INTERACT'
8805 ! include 'COMMON.CONTACTS'
8806 ! include 'COMMON.TORSION'
8807 ! include 'COMMON.VAR'
8808 ! include 'COMMON.GEO'
8809 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
8810 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
8811 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
8813 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
8814 allocate(dipderx(3,5,4,maxconts,nres))
8817 iti1 = itortyp(itype(i+1,1))
8818 if (j.lt.nres-1) then
8819 itj1 = itype2loc(itype(j+1,1))
8824 dipi(iii,1)=Ub2(iii,i)
8825 dipderi(iii)=Ub2der(iii,i)
8826 dipi(iii,2)=b1(iii,iti1)
8827 dipj(iii,1)=Ub2(iii,j)
8828 dipderj(iii)=Ub2der(iii,j)
8829 dipj(iii,2)=b1(iii,itj1)
8833 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8836 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8843 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
8847 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8852 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8853 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8855 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8857 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8859 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8862 end subroutine dipole
8864 !-----------------------------------------------------------------------------
8865 subroutine calc_eello(i,j,k,l,jj,kk)
8867 ! This subroutine computes matrices and vectors needed to calculate
8868 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
8871 ! implicit real*8 (a-h,o-z)
8872 ! include 'DIMENSIONS'
8873 ! include 'COMMON.IOUNITS'
8874 ! include 'COMMON.CHAIN'
8875 ! include 'COMMON.DERIV'
8876 ! include 'COMMON.INTERACT'
8877 ! include 'COMMON.CONTACTS'
8878 ! include 'COMMON.TORSION'
8879 ! include 'COMMON.VAR'
8880 ! include 'COMMON.GEO'
8881 ! include 'COMMON.FFIELD'
8882 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
8883 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
8884 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
8887 !el common /kutas/ lprn
8888 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8889 !d & ' jj=',jj,' kk=',kk
8890 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8891 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8892 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8895 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8896 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8899 call transpose2(aa1(1,1),aa1t(1,1))
8900 call transpose2(aa2(1,1),aa2t(1,1))
8903 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
8904 aa1tder(1,1,lll,kkk))
8905 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
8906 aa2tder(1,1,lll,kkk))
8910 ! parallel orientation of the two CA-CA-CA frames.
8912 iti=itortyp(itype(i,1))
8916 itk1=itortyp(itype(k+1,1))
8917 itj=itortyp(itype(j,1))
8918 if (l.lt.nres-1) then
8919 itl1=itortyp(itype(l+1,1))
8923 ! A1 kernel(j+1) A2T
8925 !d write (iout,'(3f10.5,5x,3f10.5)')
8926 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8928 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8929 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
8930 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8931 ! Following matrices are needed only for 6-th order cumulants
8932 IF (wcorr6.gt.0.0d0) THEN
8933 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8934 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
8935 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8936 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8937 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
8938 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8939 ADtEAderx(1,1,1,1,1,1))
8941 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8942 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
8943 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8944 ADtEA1derx(1,1,1,1,1,1))
8946 ! End 6-th order cumulants
8949 !d write (2,*) 'In calc_eello6'
8951 !d write (2,*) 'iii=',iii
8953 !d write (2,*) 'kkk=',kkk
8955 !d write (2,'(3(2f10.5),5x)')
8956 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8961 call transpose2(EUgder(1,1,k),auxmat(1,1))
8962 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8963 call transpose2(EUg(1,1,k),auxmat(1,1))
8964 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8965 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8969 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8970 EAEAderx(1,1,lll,kkk,iii,1))
8974 ! A1T kernel(i+1) A2
8975 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8976 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
8977 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8978 ! Following matrices are needed only for 6-th order cumulants
8979 IF (wcorr6.gt.0.0d0) THEN
8980 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8981 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
8982 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8983 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8984 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
8985 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8986 ADtEAderx(1,1,1,1,1,2))
8987 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8988 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
8989 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8990 ADtEA1derx(1,1,1,1,1,2))
8992 ! End 6-th order cumulants
8993 call transpose2(EUgder(1,1,l),auxmat(1,1))
8994 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8995 call transpose2(EUg(1,1,l),auxmat(1,1))
8996 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8997 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9001 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9002 EAEAderx(1,1,lll,kkk,iii,2))
9007 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9008 ! They are needed only when the fifth- or the sixth-order cumulants are
9010 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9011 call transpose2(AEA(1,1,1),auxmat(1,1))
9012 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
9013 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9014 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9015 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9016 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
9017 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9018 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
9019 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
9020 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9021 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9022 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9023 call transpose2(AEA(1,1,2),auxmat(1,1))
9024 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
9025 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9026 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9027 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9028 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
9029 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9030 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
9031 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
9032 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9033 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9034 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9035 ! Calculate the Cartesian derivatives of the vectors.
9039 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9040 call matvec2(auxmat(1,1),b1(1,iti),&
9041 AEAb1derx(1,lll,kkk,iii,1,1))
9042 call matvec2(auxmat(1,1),Ub2(1,i),&
9043 AEAb2derx(1,lll,kkk,iii,1,1))
9044 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9045 AEAb1derx(1,lll,kkk,iii,2,1))
9046 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
9047 AEAb2derx(1,lll,kkk,iii,2,1))
9048 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9049 call matvec2(auxmat(1,1),b1(1,itj),&
9050 AEAb1derx(1,lll,kkk,iii,1,2))
9051 call matvec2(auxmat(1,1),Ub2(1,j),&
9052 AEAb2derx(1,lll,kkk,iii,1,2))
9053 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9054 AEAb1derx(1,lll,kkk,iii,2,2))
9055 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
9056 AEAb2derx(1,lll,kkk,iii,2,2))
9063 ! Antiparallel orientation of the two CA-CA-CA frames.
9065 iti=itortyp(itype(i,1))
9069 itk1=itortyp(itype(k+1,1))
9070 itl=itortyp(itype(l,1))
9071 itj=itortyp(itype(j,1))
9072 if (j.lt.nres-1) then
9073 itj1=itortyp(itype(j+1,1))
9077 ! A2 kernel(j-1)T A1T
9078 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9079 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
9080 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9081 ! Following matrices are needed only for 6-th order cumulants
9082 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
9083 j.eq.i+4 .and. l.eq.i+3)) THEN
9084 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9085 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
9086 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9087 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9088 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
9089 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
9090 ADtEAderx(1,1,1,1,1,1))
9091 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9092 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
9093 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
9094 ADtEA1derx(1,1,1,1,1,1))
9096 ! End 6-th order cumulants
9097 call transpose2(EUgder(1,1,k),auxmat(1,1))
9098 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9099 call transpose2(EUg(1,1,k),auxmat(1,1))
9100 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9101 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9105 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
9106 EAEAderx(1,1,lll,kkk,iii,1))
9110 ! A2T kernel(i+1)T A1
9111 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9112 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
9113 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9114 ! Following matrices are needed only for 6-th order cumulants
9115 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
9116 j.eq.i+4 .and. l.eq.i+3)) THEN
9117 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9118 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
9119 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9120 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9121 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
9122 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
9123 ADtEAderx(1,1,1,1,1,2))
9124 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9125 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
9126 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
9127 ADtEA1derx(1,1,1,1,1,2))
9129 ! End 6-th order cumulants
9130 call transpose2(EUgder(1,1,j),auxmat(1,1))
9131 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9132 call transpose2(EUg(1,1,j),auxmat(1,1))
9133 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9134 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9138 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9139 EAEAderx(1,1,lll,kkk,iii,2))
9144 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9145 ! They are needed only when the fifth- or the sixth-order cumulants are
9147 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
9148 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9149 call transpose2(AEA(1,1,1),auxmat(1,1))
9150 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
9151 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9152 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9153 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9154 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
9155 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9156 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
9157 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
9158 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9159 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9160 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9161 call transpose2(AEA(1,1,2),auxmat(1,1))
9162 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
9163 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9164 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9165 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9166 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
9167 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9168 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
9169 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
9170 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9171 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9172 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9173 ! Calculate the Cartesian derivatives of the vectors.
9177 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9178 call matvec2(auxmat(1,1),b1(1,iti),&
9179 AEAb1derx(1,lll,kkk,iii,1,1))
9180 call matvec2(auxmat(1,1),Ub2(1,i),&
9181 AEAb2derx(1,lll,kkk,iii,1,1))
9182 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9183 AEAb1derx(1,lll,kkk,iii,2,1))
9184 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
9185 AEAb2derx(1,lll,kkk,iii,2,1))
9186 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9187 call matvec2(auxmat(1,1),b1(1,itl),&
9188 AEAb1derx(1,lll,kkk,iii,1,2))
9189 call matvec2(auxmat(1,1),Ub2(1,l),&
9190 AEAb2derx(1,lll,kkk,iii,1,2))
9191 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
9192 AEAb1derx(1,lll,kkk,iii,2,2))
9193 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
9194 AEAb2derx(1,lll,kkk,iii,2,2))
9202 end subroutine calc_eello
9203 !-----------------------------------------------------------------------------
9204 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
9209 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
9210 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
9211 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
9212 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
9213 integer :: iii,kkk,lll
9216 !el common /kutas/ lprn
9217 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9219 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
9222 !d if (lprn) write (2,*) 'In kernel'
9224 !d if (lprn) write (2,*) 'kkk=',kkk
9226 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
9227 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9229 !d write (2,*) 'lll=',lll
9230 !d write (2,*) 'iii=1'
9232 !d write (2,'(3(2f10.5),5x)')
9233 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9236 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
9237 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9239 !d write (2,*) 'lll=',lll
9240 !d write (2,*) 'iii=2'
9242 !d write (2,'(3(2f10.5),5x)')
9243 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9249 end subroutine kernel
9250 !-----------------------------------------------------------------------------
9251 real(kind=8) function eello4(i,j,k,l,jj,kk)
9252 ! implicit real*8 (a-h,o-z)
9253 ! include 'DIMENSIONS'
9254 ! include 'COMMON.IOUNITS'
9255 ! include 'COMMON.CHAIN'
9256 ! include 'COMMON.DERIV'
9257 ! include 'COMMON.INTERACT'
9258 ! include 'COMMON.CONTACTS'
9259 ! include 'COMMON.TORSION'
9260 ! include 'COMMON.VAR'
9261 ! include 'COMMON.GEO'
9262 real(kind=8),dimension(2,2) :: pizda
9263 real(kind=8),dimension(3) :: ggg1,ggg2
9264 real(kind=8) :: eel4,glongij,glongkl
9265 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9266 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9270 !d print *,'eello4:',i,j,k,l,jj,kk
9271 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
9272 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
9273 !old eij=facont_hb(jj,i)
9274 !old ekl=facont_hb(kk,k)
9276 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9277 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9278 gcorr_loc(k-1)=gcorr_loc(k-1) &
9279 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9281 gcorr_loc(l-1)=gcorr_loc(l-1) &
9282 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9284 gcorr_loc(j-1)=gcorr_loc(j-1) &
9285 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9290 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
9291 -EAEAderx(2,2,lll,kkk,iii,1)
9292 !d derx(lll,kkk,iii)=0.0d0
9296 !d gcorr_loc(l-1)=0.0d0
9297 !d gcorr_loc(j-1)=0.0d0
9298 !d gcorr_loc(k-1)=0.0d0
9300 !d write (iout,*)'Contacts have occurred for peptide groups',
9301 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
9302 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9303 if (j.lt.nres-1) then
9310 if (l.lt.nres-1) then
9318 !grad ggg1(ll)=eel4*g_contij(ll,1)
9319 !grad ggg2(ll)=eel4*g_contij(ll,2)
9320 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9321 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9322 !grad ghalf=0.5d0*ggg1(ll)
9323 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9324 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9325 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9326 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9327 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9328 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9329 !grad ghalf=0.5d0*ggg2(ll)
9330 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9331 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9332 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9333 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9334 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9335 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9339 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9344 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9349 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9354 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9358 !d write (2,*) iii,gcorr_loc(iii)
9361 !d write (2,*) 'ekont',ekont
9362 !d write (iout,*) 'eello4',ekont*eel4
9365 !-----------------------------------------------------------------------------
9366 real(kind=8) function eello5(i,j,k,l,jj,kk)
9367 ! implicit real*8 (a-h,o-z)
9368 ! include 'DIMENSIONS'
9369 ! include 'COMMON.IOUNITS'
9370 ! include 'COMMON.CHAIN'
9371 ! include 'COMMON.DERIV'
9372 ! include 'COMMON.INTERACT'
9373 ! include 'COMMON.CONTACTS'
9374 ! include 'COMMON.TORSION'
9375 ! include 'COMMON.VAR'
9376 ! include 'COMMON.GEO'
9377 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9378 real(kind=8),dimension(2) :: vv
9379 real(kind=8),dimension(3) :: ggg1,ggg2
9380 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
9381 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
9382 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
9383 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9388 ! /l\ / \ \ / \ / \ / C
9389 ! / \ / \ \ / \ / \ / C
9390 ! j| o |l1 | o | o| o | | o |o C
9391 ! \ |/k\| |/ \| / |/ \| |/ \| C
9392 ! \i/ \ / \ / / \ / \ C
9394 ! (I) (II) (III) (IV) C
9396 ! eello5_1 eello5_2 eello5_3 eello5_4 C
9398 ! Antiparallel chains C
9401 ! /j\ / \ \ / \ / \ / C
9402 ! / \ / \ \ / \ / \ / C
9403 ! j1| o |l | o | o| o | | o |o C
9404 ! \ |/k\| |/ \| / |/ \| |/ \| C
9405 ! \i/ \ / \ / / \ / \ C
9407 ! (I) (II) (III) (IV) C
9409 ! eello5_1 eello5_2 eello5_3 eello5_4 C
9411 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
9413 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9414 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9419 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9421 itk=itortyp(itype(k,1))
9422 itl=itortyp(itype(l,1))
9423 itj=itortyp(itype(j,1))
9428 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9429 !d & eel5_3_num,eel5_4_num)
9433 derx(lll,kkk,iii)=0.0d0
9437 !d eij=facont_hb(jj,i)
9438 !d ekl=facont_hb(kk,k)
9440 !d write (iout,*)'Contacts have occurred for peptide groups',
9441 !d & i,j,' fcont:',eij,' eij',' and ',k,l
9443 ! Contribution from the graph I.
9444 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9445 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9446 call transpose2(EUg(1,1,k),auxmat(1,1))
9447 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9448 vv(1)=pizda(1,1)-pizda(2,2)
9449 vv(2)=pizda(1,2)+pizda(2,1)
9450 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
9451 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9452 ! Explicit gradient in virtual-dihedral angles.
9453 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
9454 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
9455 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9456 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9457 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9458 vv(1)=pizda(1,1)-pizda(2,2)
9459 vv(2)=pizda(1,2)+pizda(2,1)
9460 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9461 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
9462 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9463 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9464 vv(1)=pizda(1,1)-pizda(2,2)
9465 vv(2)=pizda(1,2)+pizda(2,1)
9467 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9468 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
9469 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9471 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9472 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
9473 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9475 ! Cartesian gradient
9479 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9481 vv(1)=pizda(1,1)-pizda(2,2)
9482 vv(2)=pizda(1,2)+pizda(2,1)
9483 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9484 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
9485 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9491 ! Contribution from graph II
9492 call transpose2(EE(1,1,itk),auxmat(1,1))
9493 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9494 vv(1)=pizda(1,1)+pizda(2,2)
9495 vv(2)=pizda(2,1)-pizda(1,2)
9496 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
9497 -0.5d0*scalar2(vv(1),Ctobr(1,k))
9498 ! Explicit gradient in virtual-dihedral angles.
9499 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9500 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9501 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9502 vv(1)=pizda(1,1)+pizda(2,2)
9503 vv(2)=pizda(2,1)-pizda(1,2)
9505 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9506 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
9507 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9509 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9510 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
9511 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9513 ! Cartesian gradient
9517 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
9519 vv(1)=pizda(1,1)+pizda(2,2)
9520 vv(2)=pizda(2,1)-pizda(1,2)
9521 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9522 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
9523 -0.5d0*scalar2(vv(1),Ctobr(1,k))
9531 ! Parallel orientation
9532 ! Contribution from graph III
9533 call transpose2(EUg(1,1,l),auxmat(1,1))
9534 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9535 vv(1)=pizda(1,1)-pizda(2,2)
9536 vv(2)=pizda(1,2)+pizda(2,1)
9537 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
9538 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9539 ! Explicit gradient in virtual-dihedral angles.
9540 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9541 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
9542 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9543 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9544 vv(1)=pizda(1,1)-pizda(2,2)
9545 vv(2)=pizda(1,2)+pizda(2,1)
9546 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9547 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
9548 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9549 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9550 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9551 vv(1)=pizda(1,1)-pizda(2,2)
9552 vv(2)=pizda(1,2)+pizda(2,1)
9553 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9554 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
9555 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9556 ! Cartesian gradient
9560 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9562 vv(1)=pizda(1,1)-pizda(2,2)
9563 vv(2)=pizda(1,2)+pizda(2,1)
9564 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9565 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
9566 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9571 ! Contribution from graph IV
9573 call transpose2(EE(1,1,itl),auxmat(1,1))
9574 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9575 vv(1)=pizda(1,1)+pizda(2,2)
9576 vv(2)=pizda(2,1)-pizda(1,2)
9577 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
9578 -0.5d0*scalar2(vv(1),Ctobr(1,l))
9579 ! Explicit gradient in virtual-dihedral angles.
9580 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9581 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9582 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9583 vv(1)=pizda(1,1)+pizda(2,2)
9584 vv(2)=pizda(2,1)-pizda(1,2)
9585 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9586 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
9587 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9588 ! Cartesian gradient
9592 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9594 vv(1)=pizda(1,1)+pizda(2,2)
9595 vv(2)=pizda(2,1)-pizda(1,2)
9596 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9597 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
9598 -0.5d0*scalar2(vv(1),Ctobr(1,l))
9603 ! Antiparallel orientation
9604 ! Contribution from graph III
9606 call transpose2(EUg(1,1,j),auxmat(1,1))
9607 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9608 vv(1)=pizda(1,1)-pizda(2,2)
9609 vv(2)=pizda(1,2)+pizda(2,1)
9610 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
9611 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9612 ! Explicit gradient in virtual-dihedral angles.
9613 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9614 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
9615 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9616 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9617 vv(1)=pizda(1,1)-pizda(2,2)
9618 vv(2)=pizda(1,2)+pizda(2,1)
9619 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9620 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
9621 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9622 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9623 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9624 vv(1)=pizda(1,1)-pizda(2,2)
9625 vv(2)=pizda(1,2)+pizda(2,1)
9626 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9627 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
9628 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9629 ! Cartesian gradient
9633 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9635 vv(1)=pizda(1,1)-pizda(2,2)
9636 vv(2)=pizda(1,2)+pizda(2,1)
9637 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9638 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
9639 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9644 ! Contribution from graph IV
9646 call transpose2(EE(1,1,itj),auxmat(1,1))
9647 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9648 vv(1)=pizda(1,1)+pizda(2,2)
9649 vv(2)=pizda(2,1)-pizda(1,2)
9650 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
9651 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9652 ! Explicit gradient in virtual-dihedral angles.
9653 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9654 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9655 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9656 vv(1)=pizda(1,1)+pizda(2,2)
9657 vv(2)=pizda(2,1)-pizda(1,2)
9658 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9659 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
9660 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9661 ! Cartesian gradient
9665 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9667 vv(1)=pizda(1,1)+pizda(2,2)
9668 vv(2)=pizda(2,1)-pizda(1,2)
9669 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9670 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
9671 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9677 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9678 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9679 !d write (2,*) 'ijkl',i,j,k,l
9680 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9681 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
9683 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9684 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9685 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9686 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9687 if (j.lt.nres-1) then
9694 if (l.lt.nres-1) then
9704 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9705 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
9706 ! summed up outside the subrouine as for the other subroutines
9707 ! handling long-range interactions. The old code is commented out
9708 ! with "cgrad" to keep track of changes.
9710 !grad ggg1(ll)=eel5*g_contij(ll,1)
9711 !grad ggg2(ll)=eel5*g_contij(ll,2)
9712 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9713 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9714 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9715 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9716 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9717 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9718 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9719 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9721 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9722 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9723 !grad ghalf=0.5d0*ggg1(ll)
9725 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9726 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9727 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9728 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9729 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9730 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9731 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9732 !grad ghalf=0.5d0*ggg2(ll)
9734 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9735 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9736 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9737 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9738 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9739 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9744 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9745 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9750 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9751 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9757 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9762 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9766 !d write (2,*) iii,g_corr5_loc(iii)
9769 !d write (2,*) 'ekont',ekont
9770 !d write (iout,*) 'eello5',ekont*eel5
9773 !-----------------------------------------------------------------------------
9774 real(kind=8) function eello6(i,j,k,l,jj,kk)
9775 ! implicit real*8 (a-h,o-z)
9776 ! include 'DIMENSIONS'
9777 ! include 'COMMON.IOUNITS'
9778 ! include 'COMMON.CHAIN'
9779 ! include 'COMMON.DERIV'
9780 ! include 'COMMON.INTERACT'
9781 ! include 'COMMON.CONTACTS'
9782 ! include 'COMMON.TORSION'
9783 ! include 'COMMON.VAR'
9784 ! include 'COMMON.GEO'
9785 ! include 'COMMON.FFIELD'
9786 real(kind=8),dimension(3) :: ggg1,ggg2
9787 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
9789 real(kind=8) :: gradcorr6ij,gradcorr6kl
9790 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9791 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9796 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9804 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9805 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9809 derx(lll,kkk,iii)=0.0d0
9813 !d eij=facont_hb(jj,i)
9814 !d ekl=facont_hb(kk,k)
9820 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9821 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9822 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9823 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9824 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9825 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9827 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9828 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9829 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9830 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9831 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9832 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9836 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9838 ! If turn contributions are considered, they will be handled separately.
9839 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9840 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9841 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9842 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9843 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9844 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9845 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9847 if (j.lt.nres-1) then
9854 if (l.lt.nres-1) then
9862 !grad ggg1(ll)=eel6*g_contij(ll,1)
9863 !grad ggg2(ll)=eel6*g_contij(ll,2)
9864 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9865 !grad ghalf=0.5d0*ggg1(ll)
9867 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9868 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9869 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9870 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9871 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9872 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9873 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9874 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9875 !grad ghalf=0.5d0*ggg2(ll)
9876 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9878 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9879 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9880 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9881 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9882 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9883 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9888 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9889 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9894 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9895 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9901 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9906 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9910 !d write (2,*) iii,g_corr6_loc(iii)
9913 !d write (2,*) 'ekont',ekont
9914 !d write (iout,*) 'eello6',ekont*eel6
9917 !-----------------------------------------------------------------------------
9918 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
9920 ! implicit real*8 (a-h,o-z)
9921 ! include 'DIMENSIONS'
9922 ! include 'COMMON.IOUNITS'
9923 ! include 'COMMON.CHAIN'
9924 ! include 'COMMON.DERIV'
9925 ! include 'COMMON.INTERACT'
9926 ! include 'COMMON.CONTACTS'
9927 ! include 'COMMON.TORSION'
9928 ! include 'COMMON.VAR'
9929 ! include 'COMMON.GEO'
9930 real(kind=8),dimension(2) :: vv,vv1
9931 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
9934 !el common /kutas/ lprn
9935 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
9936 real(kind=8) :: s1,s2,s3,s4,s5
9937 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9939 ! Parallel Antiparallel C
9945 ! \ j|/k\| / \ |/k\|l / C
9950 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9951 itk=itortyp(itype(k,1))
9952 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9953 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9954 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9955 call transpose2(EUgC(1,1,k),auxmat(1,1))
9956 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9957 vv1(1)=pizda1(1,1)-pizda1(2,2)
9958 vv1(2)=pizda1(1,2)+pizda1(2,1)
9959 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9960 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9961 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9962 s5=scalar2(vv(1),Dtobr2(1,i))
9963 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9964 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9965 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
9966 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
9967 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
9968 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
9969 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
9970 +scalar2(vv(1),Dtobr2der(1,i)))
9971 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9972 vv1(1)=pizda1(1,1)-pizda1(2,2)
9973 vv1(2)=pizda1(1,2)+pizda1(2,1)
9974 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9975 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9977 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
9978 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9979 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9980 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9981 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9983 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
9984 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9985 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9986 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9987 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9989 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9990 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9991 vv1(1)=pizda1(1,1)-pizda1(2,2)
9992 vv1(2)=pizda1(1,2)+pizda1(2,1)
9993 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
9994 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
9995 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
9996 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10005 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10006 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10007 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10008 call transpose2(EUgC(1,1,k),auxmat(1,1))
10009 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
10011 vv1(1)=pizda1(1,1)-pizda1(2,2)
10012 vv1(2)=pizda1(1,2)+pizda1(2,1)
10013 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10014 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
10015 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
10016 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
10017 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
10018 s5=scalar2(vv(1),Dtobr2(1,i))
10019 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10024 end function eello6_graph1
10025 !-----------------------------------------------------------------------------
10026 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
10028 ! implicit real*8 (a-h,o-z)
10029 ! include 'DIMENSIONS'
10030 ! include 'COMMON.IOUNITS'
10031 ! include 'COMMON.CHAIN'
10032 ! include 'COMMON.DERIV'
10033 ! include 'COMMON.INTERACT'
10034 ! include 'COMMON.CONTACTS'
10035 ! include 'COMMON.TORSION'
10036 ! include 'COMMON.VAR'
10037 ! include 'COMMON.GEO'
10039 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
10040 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
10041 !el logical :: lprn
10042 !el common /kutas/ lprn
10043 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
10044 real(kind=8) :: s2,s3,s4
10045 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10047 ! Parallel Antiparallel C
10053 ! \ j|/k\| \ |/k\|l C
10058 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10059 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10060 ! AL 7/4/01 s1 would occur in the sixth-order moment,
10061 ! but not in a cluster cumulant
10063 s1=dip(1,jj,i)*dip(1,kk,k)
10065 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10066 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10067 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10068 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10069 call transpose2(EUg(1,1,k),auxmat(1,1))
10070 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10071 vv(1)=pizda(1,1)-pizda(2,2)
10072 vv(2)=pizda(1,2)+pizda(2,1)
10073 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10074 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10076 eello6_graph2=-(s1+s2+s3+s4)
10078 eello6_graph2=-(s2+s3+s4)
10080 ! eello6_graph2=-s3
10081 ! Derivatives in gamma(i-1)
10084 s1=dipderg(1,jj,i)*dip(1,kk,k)
10086 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10087 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10088 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10089 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10091 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10093 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10095 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10097 ! Derivatives in gamma(k-1)
10099 s1=dip(1,jj,i)*dipderg(1,kk,k)
10101 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10102 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10103 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10104 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10105 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10106 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10107 vv(1)=pizda(1,1)-pizda(2,2)
10108 vv(2)=pizda(1,2)+pizda(2,1)
10109 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10111 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10113 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10115 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10116 ! Derivatives in gamma(j-1) or gamma(l-1)
10119 s1=dipderg(3,jj,i)*dip(1,kk,k)
10121 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10122 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10123 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10124 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10125 vv(1)=pizda(1,1)-pizda(2,2)
10126 vv(2)=pizda(1,2)+pizda(2,1)
10127 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10130 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10132 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10135 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10136 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10138 ! Derivatives in gamma(l-1) or gamma(j-1)
10141 s1=dip(1,jj,i)*dipderg(3,kk,k)
10143 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10144 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10145 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10146 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10147 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10148 vv(1)=pizda(1,1)-pizda(2,2)
10149 vv(2)=pizda(1,2)+pizda(2,1)
10150 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10153 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10155 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10158 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10159 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10161 ! Cartesian derivatives.
10163 write (2,*) 'In eello6_graph2'
10165 write (2,*) 'iii=',iii
10167 write (2,*) 'kkk=',kkk
10169 write (2,'(3(2f10.5),5x)') &
10170 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10180 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10182 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10185 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
10187 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10188 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
10190 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10191 call transpose2(EUg(1,1,k),auxmat(1,1))
10192 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
10194 vv(1)=pizda(1,1)-pizda(2,2)
10195 vv(2)=pizda(1,2)+pizda(2,1)
10196 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10197 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10199 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10201 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10204 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10206 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10212 end function eello6_graph2
10213 !-----------------------------------------------------------------------------
10214 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
10215 ! implicit real*8 (a-h,o-z)
10216 ! include 'DIMENSIONS'
10217 ! include 'COMMON.IOUNITS'
10218 ! include 'COMMON.CHAIN'
10219 ! include 'COMMON.DERIV'
10220 ! include 'COMMON.INTERACT'
10221 ! include 'COMMON.CONTACTS'
10222 ! include 'COMMON.TORSION'
10223 ! include 'COMMON.VAR'
10224 ! include 'COMMON.GEO'
10225 real(kind=8),dimension(2) :: vv,auxvec
10226 real(kind=8),dimension(2,2) :: pizda,auxmat
10228 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
10229 real(kind=8) :: s1,s2,s3,s4
10230 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10232 ! Parallel Antiparallel C
10237 ! /| o |o o| o |\ C
10238 ! j|/k\| / |/k\|l / C
10243 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10245 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
10246 ! energy moment and not to the cluster cumulant.
10247 iti=itortyp(itype(i,1))
10248 if (j.lt.nres-1) then
10249 itj1=itortyp(itype(j+1,1))
10253 itk=itortyp(itype(k,1))
10254 itk1=itortyp(itype(k+1,1))
10255 if (l.lt.nres-1) then
10256 itl1=itortyp(itype(l+1,1))
10261 s1=dip(4,jj,i)*dip(4,kk,k)
10263 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
10264 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10265 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
10266 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10267 call transpose2(EE(1,1,itk),auxmat(1,1))
10268 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10269 vv(1)=pizda(1,1)+pizda(2,2)
10270 vv(2)=pizda(2,1)-pizda(1,2)
10271 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10272 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10273 !d & "sum",-(s2+s3+s4)
10275 eello6_graph3=-(s1+s2+s3+s4)
10277 eello6_graph3=-(s2+s3+s4)
10279 ! eello6_graph3=-s4
10280 ! Derivatives in gamma(k-1)
10281 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
10282 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10283 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10284 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10285 ! Derivatives in gamma(l-1)
10286 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
10287 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10288 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10289 vv(1)=pizda(1,1)+pizda(2,2)
10290 vv(2)=pizda(2,1)-pizda(1,2)
10291 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10292 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10293 ! Cartesian derivatives.
10299 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10301 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10304 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
10306 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10307 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
10309 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10310 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
10312 vv(1)=pizda(1,1)+pizda(2,2)
10313 vv(2)=pizda(2,1)-pizda(1,2)
10314 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10316 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10318 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10321 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10323 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10325 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10330 end function eello6_graph3
10331 !-----------------------------------------------------------------------------
10332 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10333 ! implicit real*8 (a-h,o-z)
10334 ! include 'DIMENSIONS'
10335 ! include 'COMMON.IOUNITS'
10336 ! include 'COMMON.CHAIN'
10337 ! include 'COMMON.DERIV'
10338 ! include 'COMMON.INTERACT'
10339 ! include 'COMMON.CONTACTS'
10340 ! include 'COMMON.TORSION'
10341 ! include 'COMMON.VAR'
10342 ! include 'COMMON.GEO'
10343 ! include 'COMMON.FFIELD'
10344 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
10345 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
10347 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
10349 real(kind=8) :: s1,s2,s3,s4
10350 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10352 ! Parallel Antiparallel C
10357 ! /| o |o o| o |\ C
10358 ! \ j|/k\| \ |/k\|l C
10363 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10365 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
10366 ! energy moment and not to the cluster cumulant.
10367 !d write (2,*) 'eello_graph4: wturn6',wturn6
10368 iti=itortyp(itype(i,1))
10369 itj=itortyp(itype(j,1))
10370 if (j.lt.nres-1) then
10371 itj1=itortyp(itype(j+1,1))
10375 itk=itortyp(itype(k,1))
10376 if (k.lt.nres-1) then
10377 itk1=itortyp(itype(k+1,1))
10381 itl=itortyp(itype(l,1))
10382 if (l.lt.nres-1) then
10383 itl1=itortyp(itype(l+1,1))
10387 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10388 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10389 !d & ' itl',itl,' itl1',itl1
10391 if (imat.eq.1) then
10392 s1=dip(3,jj,i)*dip(3,kk,k)
10394 s1=dip(2,jj,j)*dip(2,kk,l)
10397 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10398 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10400 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
10401 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10403 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
10404 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10406 call transpose2(EUg(1,1,k),auxmat(1,1))
10407 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10408 vv(1)=pizda(1,1)-pizda(2,2)
10409 vv(2)=pizda(2,1)+pizda(1,2)
10410 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10411 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10413 eello6_graph4=-(s1+s2+s3+s4)
10415 eello6_graph4=-(s2+s3+s4)
10417 ! Derivatives in gamma(i-1)
10420 if (imat.eq.1) then
10421 s1=dipderg(2,jj,i)*dip(3,kk,k)
10423 s1=dipderg(4,jj,j)*dip(2,kk,l)
10426 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10428 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
10429 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10431 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
10432 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10434 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10435 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10436 !d write (2,*) 'turn6 derivatives'
10438 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10440 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10444 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10446 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10450 ! Derivatives in gamma(k-1)
10452 if (imat.eq.1) then
10453 s1=dip(3,jj,i)*dipderg(2,kk,k)
10455 s1=dip(2,jj,j)*dipderg(4,kk,l)
10458 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10459 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10461 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
10462 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10464 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
10465 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10467 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10468 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10469 vv(1)=pizda(1,1)-pizda(2,2)
10470 vv(2)=pizda(2,1)+pizda(1,2)
10471 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10472 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10474 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10476 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10480 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10482 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10485 ! Derivatives in gamma(j-1) or gamma(l-1)
10486 if (l.eq.j+1 .and. l.gt.1) then
10487 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10488 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10489 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10490 vv(1)=pizda(1,1)-pizda(2,2)
10491 vv(2)=pizda(2,1)+pizda(1,2)
10492 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10493 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10494 else if (j.gt.1) then
10495 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10496 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10497 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10498 vv(1)=pizda(1,1)-pizda(2,2)
10499 vv(2)=pizda(2,1)+pizda(1,2)
10500 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10501 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10502 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10504 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10507 ! Cartesian derivatives.
10513 if (imat.eq.1) then
10514 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10516 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10519 if (imat.eq.1) then
10520 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10522 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10526 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
10528 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10530 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
10531 b1(1,itj1),auxvec(1))
10532 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
10534 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
10535 b1(1,itl1),auxvec(1))
10536 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
10538 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
10540 vv(1)=pizda(1,1)-pizda(2,2)
10541 vv(2)=pizda(2,1)+pizda(1,2)
10542 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10544 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10546 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
10549 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
10552 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10555 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10557 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10559 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10563 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10565 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10568 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10570 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10577 end function eello6_graph4
10578 !-----------------------------------------------------------------------------
10579 real(kind=8) function eello_turn6(i,jj,kk)
10580 ! implicit real*8 (a-h,o-z)
10581 ! include 'DIMENSIONS'
10582 ! include 'COMMON.IOUNITS'
10583 ! include 'COMMON.CHAIN'
10584 ! include 'COMMON.DERIV'
10585 ! include 'COMMON.INTERACT'
10586 ! include 'COMMON.CONTACTS'
10587 ! include 'COMMON.TORSION'
10588 ! include 'COMMON.VAR'
10589 ! include 'COMMON.GEO'
10590 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
10591 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
10592 real(kind=8),dimension(3) :: ggg1,ggg2
10593 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
10594 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
10595 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10596 ! the respective energy moment and not to the cluster cumulant.
10597 !el local variables
10598 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
10599 integer :: j1,j2,l1,l2,ll
10600 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
10601 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
10610 iti=itortyp(itype(i,1))
10611 itk=itortyp(itype(k,1))
10612 itk1=itortyp(itype(k+1,1))
10613 itl=itortyp(itype(l,1))
10614 itj=itortyp(itype(j,1))
10615 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10616 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
10617 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10622 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10624 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
10628 derx_turn(lll,kkk,iii)=0.0d0
10635 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10637 !d write (2,*) 'eello6_5',eello6_5
10639 call transpose2(AEA(1,1,1),auxmat(1,1))
10640 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10641 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
10642 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10644 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10645 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10646 s2 = scalar2(b1(1,itk),vtemp1(1))
10648 call transpose2(AEA(1,1,2),atemp(1,1))
10649 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10650 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10651 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10653 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10654 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10655 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10657 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10658 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10659 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10660 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10661 ss13 = scalar2(b1(1,itk),vtemp4(1))
10662 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10664 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10670 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10671 ! Derivatives in gamma(i+2)
10675 call transpose2(AEA(1,1,1),auxmatd(1,1))
10676 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10677 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10678 call transpose2(AEAderg(1,1,2),atempd(1,1))
10679 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10680 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10682 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10683 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10684 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10690 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10691 ! Derivatives in gamma(i+3)
10693 call transpose2(AEA(1,1,1),auxmatd(1,1))
10694 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10695 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
10696 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10698 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
10699 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10700 s2d = scalar2(b1(1,itk),vtemp1d(1))
10702 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10703 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10705 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10707 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10708 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10709 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10717 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10718 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10720 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10721 -0.5d0*ekont*(s2d+s12d)
10723 ! Derivatives in gamma(i+4)
10724 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10725 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10726 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10728 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10729 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10730 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10738 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10740 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10742 ! Derivatives in gamma(i+5)
10744 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10745 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10746 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10748 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
10749 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10750 s2d = scalar2(b1(1,itk),vtemp1d(1))
10752 call transpose2(AEA(1,1,2),atempd(1,1))
10753 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10754 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10756 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10757 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10759 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10760 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10761 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10769 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10770 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10772 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10773 -0.5d0*ekont*(s2d+s12d)
10775 ! Cartesian derivatives
10780 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10781 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10782 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10784 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10785 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
10787 s2d = scalar2(b1(1,itk),vtemp1d(1))
10789 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10790 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10791 s8d = -(atempd(1,1)+atempd(2,2))* &
10792 scalar2(cc(1,1,itl),vtemp2(1))
10794 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
10796 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10797 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10804 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10807 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10811 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10814 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10823 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
10825 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10826 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10827 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10828 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10829 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
10831 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10832 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10833 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10837 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10838 !d & 16*eel_turn6_num
10840 if (j.lt.nres-1) then
10847 if (l.lt.nres-1) then
10855 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
10856 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
10857 !grad ghalf=0.5d0*ggg1(ll)
10859 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10860 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10861 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
10862 +ekont*derx_turn(ll,2,1)
10863 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10864 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
10865 +ekont*derx_turn(ll,4,1)
10866 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10867 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10868 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10869 !grad ghalf=0.5d0*ggg2(ll)
10871 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
10872 +ekont*derx_turn(ll,2,2)
10873 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10874 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
10875 +ekont*derx_turn(ll,4,2)
10876 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10877 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10878 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10883 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10888 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10894 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10899 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10903 !d write (2,*) iii,g_corr6_loc(iii)
10905 eello_turn6=ekont*eel_turn6
10906 !d write (2,*) 'ekont',ekont
10907 !d write (2,*) 'eel_turn6',ekont*eel_turn6
10909 end function eello_turn6
10910 !-----------------------------------------------------------------------------
10911 subroutine MATVEC2(A1,V1,V2)
10912 !DIR$ INLINEALWAYS MATVEC2
10914 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10916 ! implicit real*8 (a-h,o-z)
10917 ! include 'DIMENSIONS'
10918 real(kind=8),dimension(2) :: V1,V2
10919 real(kind=8),dimension(2,2) :: A1
10920 real(kind=8) :: vaux1,vaux2
10924 ! 3 VI=VI+A1(I,K)*V1(K)
10928 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10929 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10933 end subroutine MATVEC2
10934 !-----------------------------------------------------------------------------
10935 subroutine MATMAT2(A1,A2,A3)
10937 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10939 ! implicit real*8 (a-h,o-z)
10940 ! include 'DIMENSIONS'
10941 real(kind=8),dimension(2,2) :: A1,A2,A3
10942 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
10943 ! DIMENSION AI3(2,2)
10947 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
10953 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10954 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10955 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10956 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10962 end subroutine MATMAT2
10963 !-----------------------------------------------------------------------------
10964 real(kind=8) function scalar2(u,v)
10965 !DIR$ INLINEALWAYS scalar2
10967 real(kind=8),dimension(2) :: u,v
10970 scalar2=u(1)*v(1)+u(2)*v(2)
10972 end function scalar2
10973 !-----------------------------------------------------------------------------
10974 subroutine transpose2(a,at)
10975 !DIR$ INLINEALWAYS transpose2
10977 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
10980 real(kind=8),dimension(2,2) :: a,at
10986 end subroutine transpose2
10987 !-----------------------------------------------------------------------------
10988 subroutine transpose(n,a,at)
10991 real(kind=8),dimension(n,n) :: a,at
10998 end subroutine transpose
10999 !-----------------------------------------------------------------------------
11000 subroutine prodmat3(a1,a2,kk,transp,prod)
11001 !DIR$ INLINEALWAYS prodmat3
11003 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
11007 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
11009 !rc double precision auxmat(2,2),prod_(2,2)
11012 !rc call transpose2(kk(1,1),auxmat(1,1))
11013 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11014 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11016 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
11017 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11018 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
11019 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11020 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
11021 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11022 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
11023 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11026 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11027 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11029 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
11030 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11031 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
11032 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11033 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
11034 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11035 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
11036 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11039 ! call transpose2(a2(1,1),a2t(1,1))
11042 !rc print *,((prod_(i,j),i=1,2),j=1,2)
11043 !rc print *,((prod(i,j),i=1,2),j=1,2)
11046 end subroutine prodmat3
11047 !-----------------------------------------------------------------------------
11048 ! energy_p_new_barrier.F
11049 !-----------------------------------------------------------------------------
11050 subroutine sum_gradient
11051 ! implicit real*8 (a-h,o-z)
11052 use io_base, only: pdbout
11053 ! include 'DIMENSIONS'
11057 !MS$ATTRIBUTES C :: proc_proc
11063 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
11064 gloc_scbuf !(3,maxres)
11066 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
11068 !el local variables
11069 integer :: i,j,k,ierror,ierr
11070 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
11071 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
11072 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
11073 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
11074 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
11075 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
11076 gsccorr_max,gsccorrx_max,time00
11078 ! include 'COMMON.SETUP'
11079 ! include 'COMMON.IOUNITS'
11080 ! include 'COMMON.FFIELD'
11081 ! include 'COMMON.DERIV'
11082 ! include 'COMMON.INTERACT'
11083 ! include 'COMMON.SBRIDGE'
11084 ! include 'COMMON.CHAIN'
11085 ! include 'COMMON.VAR'
11086 ! include 'COMMON.CONTROL'
11087 ! include 'COMMON.TIME1'
11088 ! include 'COMMON.MAXGRAD'
11089 ! include 'COMMON.SCCOR'
11095 write (iout,*) "sum_gradient gvdwc, gvdwx"
11097 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
11098 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
11108 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
11109 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
11110 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
11113 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
11114 ! in virtual-bond-vector coordinates
11117 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
11119 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
11120 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
11122 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
11124 ! write (iout,'(i5,3f10.5,2x,f10.5)')
11125 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
11127 ! write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
11129 ! write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
11130 ! i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
11131 ! (gvdwc_scpp(j,i),j=1,3)
11133 ! write (iout,*) "gelc_long gvdwpp gel_loc_long"
11135 ! write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
11136 ! i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
11137 ! (gelc_loc_long(j,i),j=1,3)
11144 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
11145 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
11146 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
11147 wel_loc*gel_loc_long(j,i)+ &
11148 wcorr*gradcorr_long(j,i)+ &
11149 wcorr5*gradcorr5_long(j,i)+ &
11150 wcorr6*gradcorr6_long(j,i)+ &
11151 wturn6*gcorr6_turn_long(j,i)+ &
11152 wstrain*ghpbc(j,i) &
11153 +wliptran*gliptranc(j,i) &
11155 +welec*gshieldc(j,i) &
11156 +wcorr*gshieldc_ec(j,i) &
11157 +wturn3*gshieldc_t3(j,i)&
11158 +wturn4*gshieldc_t4(j,i)&
11159 +wel_loc*gshieldc_ll(j,i)&
11160 +wtube*gg_tube(j,i) &
11161 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
11162 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
11163 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
11164 wcorr_nucl*gradcorr_nucl(j,i)&
11165 +wcorr3_nucl*gradcorr3_nucl(j,i)+&
11166 wcatprot* gradpepcat(j,i)+ &
11167 wcatcat*gradcatcat(j,i)+ &
11168 wscbase*gvdwc_scbase(j,i)+ &
11169 wpepbase*gvdwc_pepbase(j,i)+&
11170 wscpho*gvdwc_scpho(j,i)+ &
11171 wpeppho*gvdwc_peppho(j,i)+wcatnucl*gradnuclcat(j,i)
11182 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
11183 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
11184 welec*gelc_long(j,i)+ &
11185 wbond*gradb(j,i)+ &
11186 wel_loc*gel_loc_long(j,i)+ &
11187 wcorr*gradcorr_long(j,i)+ &
11188 wcorr5*gradcorr5_long(j,i)+ &
11189 wcorr6*gradcorr6_long(j,i)+ &
11190 wturn6*gcorr6_turn_long(j,i)+ &
11191 wstrain*ghpbc(j,i) &
11192 +wliptran*gliptranc(j,i) &
11194 +welec*gshieldc(j,i)&
11195 +wcorr*gshieldc_ec(j,i) &
11196 +wturn4*gshieldc_t4(j,i) &
11197 +wel_loc*gshieldc_ll(j,i)&
11198 +wtube*gg_tube(j,i) &
11199 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
11200 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
11201 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
11202 wcorr_nucl*gradcorr_nucl(j,i) &
11203 +wcorr3_nucl*gradcorr3_nucl(j,i) +&
11204 wcatprot* gradpepcat(j,i)+ &
11205 wcatcat*gradcatcat(j,i)+ &
11206 wscbase*gvdwc_scbase(j,i)+ &
11207 wpepbase*gvdwc_pepbase(j,i)+&
11208 wscpho*gvdwc_scpho(j,i)+&
11209 wpeppho*gvdwc_peppho(j,i)+wcatnucl*gradnuclcat(j,i)
11216 if (nfgtasks.gt.1) then
11219 write (iout,*) "gradbufc before allreduce"
11221 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11227 gradbufc_sum(j,i)=gradbufc(j,i)
11230 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
11231 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
11232 ! time_reduce=time_reduce+MPI_Wtime()-time00
11234 ! write (iout,*) "gradbufc_sum after allreduce"
11236 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
11241 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
11245 gradbufc(k,i)=0.0d0
11249 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
11250 write (iout,*) (i," jgrad_start",jgrad_start(i),&
11251 " jgrad_end ",jgrad_end(i),&
11252 i=igrad_start,igrad_end)
11255 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
11256 ! do not parallelize this part.
11258 ! do i=igrad_start,igrad_end
11259 ! do j=jgrad_start(i),jgrad_end(i)
11261 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
11266 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
11270 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
11274 write (iout,*) "gradbufc after summing"
11276 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11284 write (iout,*) "gradbufc"
11286 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11293 gradbufc_sum(j,i)=gradbufc(j,i)
11294 gradbufc(j,i)=0.0d0
11298 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
11302 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
11307 ! gradbufc(k,i)=0.0d0
11311 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
11317 write (iout,*) "gradbufc after summing"
11319 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11328 gradbufc(k,nres)=0.0d0
11330 !el----------------
11331 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
11332 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
11333 !el-----------------
11337 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
11338 wel_loc*gel_loc(j,i)+ &
11339 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
11340 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
11341 wel_loc*gel_loc_long(j,i)+ &
11342 wcorr*gradcorr_long(j,i)+ &
11343 wcorr5*gradcorr5_long(j,i)+ &
11344 wcorr6*gradcorr6_long(j,i)+ &
11345 wturn6*gcorr6_turn_long(j,i))+ &
11346 wbond*gradb(j,i)+ &
11347 wcorr*gradcorr(j,i)+ &
11348 wturn3*gcorr3_turn(j,i)+ &
11349 wturn4*gcorr4_turn(j,i)+ &
11350 wcorr5*gradcorr5(j,i)+ &
11351 wcorr6*gradcorr6(j,i)+ &
11352 wturn6*gcorr6_turn(j,i)+ &
11353 wsccor*gsccorc(j,i) &
11354 +wscloc*gscloc(j,i) &
11355 +wliptran*gliptranc(j,i) &
11357 +welec*gshieldc(j,i) &
11358 +welec*gshieldc_loc(j,i) &
11359 +wcorr*gshieldc_ec(j,i) &
11360 +wcorr*gshieldc_loc_ec(j,i) &
11361 +wturn3*gshieldc_t3(j,i) &
11362 +wturn3*gshieldc_loc_t3(j,i) &
11363 +wturn4*gshieldc_t4(j,i) &
11364 +wturn4*gshieldc_loc_t4(j,i) &
11365 +wel_loc*gshieldc_ll(j,i) &
11366 +wel_loc*gshieldc_loc_ll(j,i) &
11367 +wtube*gg_tube(j,i) &
11368 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
11369 +wvdwpsb*gvdwpsb1(j,i))&
11370 +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
11371 ! if (i.eq.21) then
11372 ! print *,"in sum",gradc(j,i,icg),wturn4*gcorr4_turn(j,i),&
11373 ! wturn4*gshieldc_t4(j,i), &
11374 ! wturn4*gshieldc_loc_t4(j,i)
11376 ! if ((i.le.2).and.(i.ge.1))
11377 ! print *,gradc(j,i,icg),&
11378 ! gradbufc(j,i),welec*gelc(j,i), &
11379 ! wel_loc*gel_loc(j,i), &
11380 ! wscp*gvdwc_scpp(j,i), &
11381 ! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
11382 ! wel_loc*gel_loc_long(j,i), &
11383 ! wcorr*gradcorr_long(j,i), &
11384 ! wcorr5*gradcorr5_long(j,i), &
11385 ! wcorr6*gradcorr6_long(j,i), &
11386 ! wturn6*gcorr6_turn_long(j,i), &
11387 ! wbond*gradb(j,i), &
11388 ! wcorr*gradcorr(j,i), &
11389 ! wturn3*gcorr3_turn(j,i), &
11390 ! wturn4*gcorr4_turn(j,i), &
11391 ! wcorr5*gradcorr5(j,i), &
11392 ! wcorr6*gradcorr6(j,i), &
11393 ! wturn6*gcorr6_turn(j,i), &
11394 ! wsccor*gsccorc(j,i) &
11395 ! ,wscloc*gscloc(j,i) &
11396 ! ,wliptran*gliptranc(j,i) &
11398 ! ,welec*gshieldc(j,i) &
11399 ! ,welec*gshieldc_loc(j,i) &
11400 ! ,wcorr*gshieldc_ec(j,i) &
11401 ! ,wcorr*gshieldc_loc_ec(j,i) &
11402 ! ,wturn3*gshieldc_t3(j,i) &
11403 ! ,wturn3*gshieldc_loc_t3(j,i) &
11404 ! ,wturn4*gshieldc_t4(j,i) &
11405 ! ,wturn4*gshieldc_loc_t4(j,i) &
11406 ! ,wel_loc*gshieldc_ll(j,i) &
11407 ! ,wel_loc*gshieldc_loc_ll(j,i) &
11408 ! ,wtube*gg_tube(j,i) &
11409 ! ,wbond_nucl*gradb_nucl(j,i) &
11410 ! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
11411 ! wvdwpsb*gvdwpsb1(j,i)&
11412 ! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
11416 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
11417 wel_loc*gel_loc(j,i)+ &
11418 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
11419 welec*gelc_long(j,i)+ &
11420 wel_loc*gel_loc_long(j,i)+ &
11421 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
11422 wcorr5*gradcorr5_long(j,i)+ &
11423 wcorr6*gradcorr6_long(j,i)+ &
11424 wturn6*gcorr6_turn_long(j,i))+ &
11425 wbond*gradb(j,i)+ &
11426 wcorr*gradcorr(j,i)+ &
11427 wturn3*gcorr3_turn(j,i)+ &
11428 wturn4*gcorr4_turn(j,i)+ &
11429 wcorr5*gradcorr5(j,i)+ &
11430 wcorr6*gradcorr6(j,i)+ &
11431 wturn6*gcorr6_turn(j,i)+ &
11432 wsccor*gsccorc(j,i) &
11433 +wscloc*gscloc(j,i) &
11435 +wliptran*gliptranc(j,i) &
11436 +welec*gshieldc(j,i) &
11437 +welec*gshieldc_loc(j,i) &
11438 +wcorr*gshieldc_ec(j,i) &
11439 +wcorr*gshieldc_loc_ec(j,i) &
11440 +wturn3*gshieldc_t3(j,i) &
11441 +wturn3*gshieldc_loc_t3(j,i) &
11442 +wturn4*gshieldc_t4(j,i) &
11443 +wturn4*gshieldc_loc_t4(j,i) &
11444 +wel_loc*gshieldc_ll(j,i) &
11445 +wel_loc*gshieldc_loc_ll(j,i) &
11446 +wtube*gg_tube(j,i) &
11447 +wbond_nucl*gradb_nucl(j,i) &
11448 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
11449 +wvdwpsb*gvdwpsb1(j,i))&
11450 +wsbloc*gsbloc(j,i)+wcatnucl*gradnuclcat(j,i)
11456 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
11457 wbond*gradbx(j,i)+ &
11458 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
11459 wsccor*gsccorx(j,i) &
11460 +wscloc*gsclocx(j,i) &
11461 +wliptran*gliptranx(j,i) &
11462 +welec*gshieldx(j,i) &
11463 +wcorr*gshieldx_ec(j,i) &
11464 +wturn3*gshieldx_t3(j,i) &
11465 +wturn4*gshieldx_t4(j,i) &
11466 +wel_loc*gshieldx_ll(j,i)&
11467 +wtube*gg_tube_sc(j,i) &
11468 +wbond_nucl*gradbx_nucl(j,i) &
11469 +wvdwsb*gvdwsbx(j,i) &
11470 +welsb*gelsbx(j,i) &
11471 +wcorr_nucl*gradxorr_nucl(j,i)&
11472 +wcorr3_nucl*gradxorr3_nucl(j,i) &
11473 +wsbloc*gsblocx(j,i) &
11474 +wcatprot* gradpepcatx(j,i)&
11475 +wscbase*gvdwx_scbase(j,i) &
11476 +wpepbase*gvdwx_pepbase(j,i)&
11477 +wscpho*gvdwx_scpho(j,i)+wcatnucl*gradnuclcatx(j,i)
11478 ! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
11484 write (iout,*) "gloc before adding corr"
11486 write (iout,*) i,gloc(i,icg)
11490 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
11491 +wcorr5*g_corr5_loc(i) &
11492 +wcorr6*g_corr6_loc(i) &
11493 +wturn4*gel_loc_turn4(i) &
11494 +wturn3*gel_loc_turn3(i) &
11495 +wturn6*gel_loc_turn6(i) &
11496 +wel_loc*gel_loc_loc(i)
11499 write (iout,*) "gloc after adding corr"
11501 write (iout,*) i,gloc(i,icg)
11506 if (nfgtasks.gt.1) then
11509 gradbufc(j,i)=gradc(j,i,icg)
11510 gradbufx(j,i)=gradx(j,i,icg)
11514 glocbuf(i)=gloc(i,icg)
11518 write (iout,*) "gloc_sc before reduce"
11521 write (iout,*) i,j,gloc_sc(j,i,icg)
11528 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
11532 call MPI_Barrier(FG_COMM,IERR)
11533 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
11535 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
11536 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11537 call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
11538 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11539 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
11540 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11541 time_reduce=time_reduce+MPI_Wtime()-time00
11542 call MPI_Reduce(gloc_scbuf(1,0),gloc_sc(1,0,icg),3*nres+3,&
11543 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11544 time_reduce=time_reduce+MPI_Wtime()-time00
11546 ! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
11548 write (iout,*) "gloc_sc after reduce"
11551 write (iout,*) i,j,gloc_sc(j,i,icg)
11557 write (iout,*) "gloc after reduce"
11559 write (iout,*) i,gloc(i,icg)
11564 if (gnorm_check) then
11566 ! Compute the maximum elements of the gradient
11569 gvdwc_scp_max=0.0d0
11576 gcorr3_turn_max=0.0d0
11577 gcorr4_turn_max=0.0d0
11578 gradcorr5_max=0.0d0
11579 gradcorr6_max=0.0d0
11580 gcorr6_turn_max=0.0d0
11584 gradx_scp_max=0.0d0
11590 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
11591 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
11592 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
11593 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
11594 gvdwc_scp_max=gvdwc_scp_norm
11595 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
11596 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
11597 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
11598 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
11599 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
11600 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
11601 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
11602 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
11603 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
11604 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
11605 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
11606 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
11607 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
11609 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
11610 gcorr3_turn_max=gcorr3_turn_norm
11611 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
11613 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
11614 gcorr4_turn_max=gcorr4_turn_norm
11615 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
11616 if (gradcorr5_norm.gt.gradcorr5_max) &
11617 gradcorr5_max=gradcorr5_norm
11618 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
11619 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
11620 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
11622 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
11623 gcorr6_turn_max=gcorr6_turn_norm
11624 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
11625 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
11626 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
11627 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
11628 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
11629 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
11630 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
11631 if (gradx_scp_norm.gt.gradx_scp_max) &
11632 gradx_scp_max=gradx_scp_norm
11633 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
11634 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
11635 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
11636 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
11637 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
11638 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
11639 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
11640 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
11644 open(istat,file=statname,position="append")
11646 open(istat,file=statname,access="append")
11648 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
11649 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
11650 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
11651 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
11652 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
11653 gsccorx_max,gsclocx_max
11655 if (gvdwc_max.gt.1.0d4) then
11656 write (iout,*) "gvdwc gvdwx gradb gradbx"
11658 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
11659 gradb(j,i),gradbx(j,i),j=1,3)
11661 call pdbout(0.0d0,'cipiszcze',iout)
11668 write (iout,*) "gradc gradx gloc"
11670 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
11671 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
11676 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
11679 end subroutine sum_gradient
11680 !-----------------------------------------------------------------------------
11682 ! implicit real*8 (a-h,o-z)
11684 ! include 'DIMENSIONS'
11685 ! include 'COMMON.CHAIN'
11686 ! include 'COMMON.DERIV'
11687 ! include 'COMMON.CALC'
11688 ! include 'COMMON.IOUNITS'
11689 real(kind=8), dimension(3) :: dcosom1,dcosom2
11690 ! print *,"wchodze"
11691 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
11692 +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
11693 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
11694 +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
11696 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11697 -2.0D0*alf12*eps3der+sigder*sigsq_om12&
11698 +dCAVdOM12+ dGCLdOM12
11702 ! eom12=evdwij*eps1_om12
11704 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
11706 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
11707 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
11708 !C print *,sss_ele_cut,'in sc_grad'
11710 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11711 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
11714 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
11715 !C print *,'gg',k,gg(k)
11717 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11718 ! write (iout,*) "gg",(gg(k),k=1,3)
11720 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
11721 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11722 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
11725 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
11726 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11727 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
11730 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11731 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11732 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11733 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11736 ! Calculate the components of the gradient in DC and X
11740 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
11744 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
11745 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
11748 end subroutine sc_grad
11750 subroutine sc_grad_cat
11752 real(kind=8), dimension(3) :: dcosom1,dcosom2
11753 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
11754 +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
11755 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
11756 +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
11758 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11759 -2.0D0*alf12*eps3der+sigder*sigsq_om12&
11760 +dCAVdOM12+ dGCLdOM12
11764 ! eom12=evdwij*eps1_om12
11768 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11769 dcosom2(k)=rij*(dc_norm(k,j)-om2*erij(k))
11772 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))
11773 ! print *,'gg',k,gg(k)
11775 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11776 ! write (iout,*) "gg",(gg(k),k=1,3)
11778 gradpepcatx(k,i)=gradpepcatx(k,i)-gg(k) &
11779 +(eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
11780 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11782 ! gradpepcatx(k,j)=gradpepcatx(k,j)+gg(k) &
11783 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)) &
11784 ! +eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv
11786 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11787 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11788 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11789 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11792 ! Calculate the components of the gradient in DC and X
11795 gradpepcat(l,i)=gradpepcat(l,i)-gg(l)
11796 gradpepcat(l,j)=gradpepcat(l,j)+gg(l)
11798 end subroutine sc_grad_cat
11800 subroutine sc_grad_cat_pep
11802 real(kind=8), dimension(3) :: dcosom1,dcosom2
11803 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
11804 +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
11805 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
11806 +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
11808 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11809 -2.0D0*alf12*eps3der+sigder*sigsq_om12&
11810 +dCAVdOM12+ dGCLdOM12
11814 ! eom12=evdwij*eps1_om12
11818 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
11819 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
11820 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
11821 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
11822 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
11824 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
11825 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
11826 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
11828 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
11829 gradpepcat(k,j)=gradpepcat(k,j)+gg(k)
11831 end subroutine sc_grad_cat_pep
11834 !-----------------------------------------------------------------------------
11835 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
11838 ! implicit real*8 (a-h,o-z)
11839 ! include 'DIMENSIONS'
11840 ! include 'COMMON.LOCAL'
11841 ! include 'COMMON.IOUNITS'
11842 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
11843 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11844 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
11845 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
11846 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
11848 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
11849 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11850 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
11851 !el local variables
11853 delthec=thetai-thet_pred_mean
11854 delthe0=thetai-theta0i
11855 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
11856 t3 = thetai-thet_pred_mean
11860 t14 = t12+t6*sigsqtc
11862 t21 = thetai-theta0i
11868 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
11869 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
11870 *(-t12*t9-ak*sig0inv*t27)
11872 end subroutine mixder
11874 !-----------------------------------------------------------------------------
11876 !-----------------------------------------------------------------------------
11878 !-----------------------------------------------------------------------------
11879 ! This subroutine calculates the derivatives of the consecutive virtual
11880 ! bond vectors and the SC vectors in the virtual-bond angles theta and
11881 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
11882 ! in the angles alpha and omega, describing the location of a side chain
11883 ! in its local coordinate system.
11885 ! The derivatives are stored in the following arrays:
11887 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
11888 ! The structure is as follows:
11890 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
11891 ! 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)
11892 ! . . . . . . . . . . . . . . . . . .
11893 ! 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)
11897 ! 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)
11899 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
11900 ! The structure is same as above.
11902 ! DCDS - the derivatives of the side chain vectors in the local spherical
11903 ! andgles alph and omega:
11905 ! 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)
11906 ! 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)
11910 ! 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)
11912 ! Version of March '95, based on an early version of November '91.
11914 !**********************************************************************
11915 ! implicit real*8 (a-h,o-z)
11916 ! include 'DIMENSIONS'
11917 ! include 'COMMON.VAR'
11918 ! include 'COMMON.CHAIN'
11919 ! include 'COMMON.DERIV'
11920 ! include 'COMMON.GEO'
11921 ! include 'COMMON.LOCAL'
11922 ! include 'COMMON.INTERACT'
11923 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
11924 real(kind=8),dimension(3,3) :: dp,temp
11925 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
11926 real(kind=8),dimension(3) :: xx,xx1
11927 !el local variables
11928 integer :: i,k,l,j,m,ind,ind1,jjj
11929 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
11930 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
11931 sint2,xp,yp,xxp,yyp,zzp,dj
11933 ! common /przechowalnia/ fromto
11934 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
11935 ! get the position of the jth ijth fragment of the chain coordinate system
11936 ! in the fromto array.
11937 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11939 ! maxdim=(nres-1)*(nres-2)/2
11940 ! allocate(dcdv(6,maxdim),dxds(6,nres))
11941 ! calculate the derivatives of transformation matrix elements in theta
11944 !el call flush(iout) !el
11946 rdt(1,1,i)=-rt(1,2,i)
11947 rdt(1,2,i)= rt(1,1,i)
11949 rdt(2,1,i)=-rt(2,2,i)
11950 rdt(2,2,i)= rt(2,1,i)
11952 rdt(3,1,i)=-rt(3,2,i)
11953 rdt(3,2,i)= rt(3,1,i)
11957 ! derivatives in phi
11963 drt(2,1,i)= rt(3,1,i)
11964 drt(2,2,i)= rt(3,2,i)
11965 drt(2,3,i)= rt(3,3,i)
11966 drt(3,1,i)=-rt(2,1,i)
11967 drt(3,2,i)=-rt(2,2,i)
11968 drt(3,3,i)=-rt(2,3,i)
11971 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
11977 temp(k,l)=rt(k,l,i)
11982 fromto(k,l,ind)=temp(k,l)
11991 dpkl=dpkl+temp(k,m)*rt(m,l,j)
11994 fromto(k,l,ind)=dpkl
12005 ! Calculate derivatives.
12011 ! Derivatives of DC(i+1) in theta(i+2)
12017 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
12020 prordt(j,k,i)=dp(j,k)
12023 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
12026 ! Derivatives of SC(i+1) in theta(i+2)
12028 xx1(1)=-0.5D0*xloc(2,i+1)
12029 xx1(2)= 0.5D0*xloc(1,i+1)
12033 xj=xj+r(j,k,i)*xx1(k)
12040 rj=rj+prod(j,k,i)*xx(k)
12045 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
12046 ! than the other off-diagonal derivatives.
12051 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
12053 dxdv(j,ind1+1)=dxoiij
12055 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
12057 ! Derivatives of DC(i+1) in phi(i+2)
12063 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
12066 prodrt(j,k,i)=dp(j,k)
12068 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
12071 ! Derivatives of SC(i+1) in phi(i+2)
12074 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
12075 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
12079 rj=rj+prod(j,k,i)*xx(k)
12084 ! Derivatives of SC(i+1) in phi(i+3).
12089 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
12091 dxdv(j+3,ind1+1)=dxoiij
12094 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
12095 ! theta(nres) and phi(i+3) thru phi(nres).
12099 ind=indmat(i+1,j+1)
12100 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
12105 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
12110 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
12111 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
12112 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
12113 ! Derivatives of virtual-bond vectors in theta
12115 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
12117 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
12118 ! Derivatives of SC vectors in theta
12122 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
12124 dxdv(k,ind1+1)=dxoijk
12127 !--- Calculate the derivatives in phi
12133 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
12139 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
12144 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
12146 dxdv(k+3,ind1+1)=dxoijk
12151 ! Derivatives in alpha and omega:
12154 ! dsci=dsc(itype(i,1))
12159 if(alphi.ne.alphi) alphi=100.0
12160 if(omegi.ne.omegi) omegi=-100.0
12165 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
12166 cosalphi=dcos(alphi)
12167 sinalphi=dsin(alphi)
12168 cosomegi=dcos(omegi)
12169 sinomegi=dsin(omegi)
12170 temp(1,1)=-dsci*sinalphi
12171 temp(2,1)= dsci*cosalphi*cosomegi
12172 temp(3,1)=-dsci*cosalphi*sinomegi
12174 temp(2,2)=-dsci*sinalphi*sinomegi
12175 temp(3,2)=-dsci*sinalphi*cosomegi
12176 theta2=pi-0.5D0*theta(i+1)
12180 !d print *,((temp(l,k),l=1,3),k=1,2)
12184 xxp= xp*cost2+yp*sint2
12185 yyp=-xp*sint2+yp*cost2
12188 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
12189 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
12193 dj=dj+prod(k,l,i-1)*xx(l)
12201 end subroutine cartder
12202 !-----------------------------------------------------------------------------
12204 !-----------------------------------------------------------------------------
12205 subroutine check_cartgrad
12206 ! Check the gradient of Cartesian coordinates in internal coordinates.
12207 ! implicit real*8 (a-h,o-z)
12208 ! include 'DIMENSIONS'
12209 ! include 'COMMON.IOUNITS'
12210 ! include 'COMMON.VAR'
12211 ! include 'COMMON.CHAIN'
12212 ! include 'COMMON.GEO'
12213 ! include 'COMMON.LOCAL'
12214 ! include 'COMMON.DERIV'
12215 real(kind=8),dimension(6,nres) :: temp
12216 real(kind=8),dimension(3) :: xx,gg
12217 integer :: i,k,j,ii
12218 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
12219 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
12221 ! Check the gradient of the virtual-bond and SC vectors in the internal
12227 write (iout,'(a)') '**************** dx/dalpha'
12231 alph(i)=alph(i)+aincr
12233 temp(k,i)=dc(k,nres+i)
12237 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
12238 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
12240 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
12241 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
12247 write (iout,'(a)') '**************** dx/domega'
12251 omeg(i)=omeg(i)+aincr
12253 temp(k,i)=dc(k,nres+i)
12257 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
12258 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
12259 (aincr*dabs(dxds(k+3,i))+aincr))
12261 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
12262 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
12268 write (iout,'(a)') '**************** dx/dtheta'
12272 theta(i)=theta(i)+aincr
12275 temp(k,j)=dc(k,nres+j)
12281 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
12283 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
12284 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
12285 (aincr*dabs(dxdv(k,ii))+aincr))
12287 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12288 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
12295 write (iout,'(a)') '***************** dx/dphi'
12298 phi(i)=phi(i)+aincr
12301 temp(k,j)=dc(k,nres+j)
12309 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
12310 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
12311 (aincr*dabs(dxdv(k+3,ii))+aincr))
12313 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12314 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
12317 phi(i)=phi(i)-aincr
12320 write (iout,'(a)') '****************** ddc/dtheta'
12323 theta(i+2)=thet+aincr
12334 gg(k)=(dc(k,j)-temp(k,j))/aincr
12335 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
12336 (aincr*dabs(dcdv(k,ii))+aincr))
12338 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12339 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
12349 write (iout,'(a)') '******************* ddc/dphi'
12352 phi(i+3)=phii+aincr
12363 gg(k)=(dc(k,j)-temp(k,j))/aincr
12364 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
12365 (aincr*dabs(dcdv(k+3,ii))+aincr))
12367 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12368 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
12379 end subroutine check_cartgrad
12380 !-----------------------------------------------------------------------------
12381 subroutine check_ecart
12382 ! Check the gradient of the energy in Cartesian coordinates.
12383 ! implicit real*8 (a-h,o-z)
12384 ! include 'DIMENSIONS'
12385 ! include 'COMMON.CHAIN'
12386 ! include 'COMMON.DERIV'
12387 ! include 'COMMON.IOUNITS'
12388 ! include 'COMMON.VAR'
12389 ! include 'COMMON.CONTACTS'
12391 !el integer :: icall
12392 !el common /srutu/ icall
12393 real(kind=8),dimension(6) :: ggg
12394 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12395 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12396 real(kind=8),dimension(6,nres) :: grad_s
12397 real(kind=8),dimension(0:n_ene) :: energia,energia1
12398 integer :: uiparm(1)
12399 real(kind=8) :: urparm(1)
12401 integer :: nf,i,j,k
12402 real(kind=8) :: aincr,etot,etot1
12408 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
12411 call geom_to_var(nvar,x)
12412 call etotal(energia)
12414 !el call enerprint(energia)
12415 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
12418 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12422 grad_s(j,i)=gradc(j,i,icg)
12423 grad_s(j+3,i)=gradx(j,i,icg)
12427 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12432 ddx(j)=dc(j,i+nres)
12435 dc(j,i)=dc(j,i)+aincr
12437 c(j,k)=c(j,k)+aincr
12438 c(j,k+nres)=c(j,k+nres)+aincr
12441 call etotal(energia1)
12443 ggg(j)=(etot1-etot)/aincr
12446 c(j,k)=c(j,k)-aincr
12447 c(j,k+nres)=c(j,k+nres)-aincr
12451 c(j,i+nres)=c(j,i+nres)+aincr
12452 dc(j,i+nres)=dc(j,i+nres)+aincr
12454 call etotal(energia1)
12456 ggg(j+3)=(etot1-etot)/aincr
12458 dc(j,i+nres)=ddx(j)
12460 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
12461 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
12464 end subroutine check_ecart
12466 !-----------------------------------------------------------------------------
12467 subroutine check_ecartint
12468 ! Check the gradient of the energy in Cartesian coordinates.
12469 use io_base, only: intout
12470 ! implicit real*8 (a-h,o-z)
12471 ! include 'DIMENSIONS'
12472 ! include 'COMMON.CONTROL'
12473 ! include 'COMMON.CHAIN'
12474 ! include 'COMMON.DERIV'
12475 ! include 'COMMON.IOUNITS'
12476 ! include 'COMMON.VAR'
12477 ! include 'COMMON.CONTACTS'
12478 ! include 'COMMON.MD'
12479 ! include 'COMMON.LOCAL'
12480 ! include 'COMMON.SPLITELE'
12482 !el integer :: icall
12483 !el common /srutu/ icall
12484 real(kind=8),dimension(6) :: ggg,ggg1
12485 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
12486 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12487 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
12488 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12489 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12490 real(kind=8),dimension(0:n_ene) :: energia,energia1
12491 integer :: uiparm(1)
12492 real(kind=8) :: urparm(1)
12494 integer :: i,j,k,nf
12495 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12503 ! call intcartderiv
12504 ! call checkintcartgrad
12507 write(iout,*) 'Calling CHECK_ECARTINT.'
12510 call geom_to_var(nvar,x)
12511 write (iout,*) "split_ene ",split_ene
12513 if (.not.split_ene) then
12515 call etotal(energia)
12520 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12523 grad_s(j,0)=gcart(j,0)
12527 grad_s(j,i)=gcart(j,i)
12528 grad_s(j+3,i)=gxcart(j,i)
12529 write(iout,*) "before movement analytical gradient"
12531 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12532 (gxcart(j,i),j=1,3)
12538 !- split gradient check
12540 call etotal_long(energia)
12541 !el call enerprint(energia)
12545 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12546 (gxcart(j,i),j=1,3)
12549 grad_s(j,0)=gcart(j,0)
12553 grad_s(j,i)=gcart(j,i)
12554 grad_s(j+3,i)=gxcart(j,i)
12558 call etotal_short(energia)
12559 call enerprint(energia)
12563 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12564 (gxcart(j,i),j=1,3)
12567 grad_s1(j,0)=gcart(j,0)
12571 grad_s1(j,i)=gcart(j,i)
12572 grad_s1(j+3,i)=gxcart(j,i)
12576 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12580 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
12581 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
12584 dcnorm_safe1(j)=dc_norm(j,i-1)
12585 dcnorm_safe2(j)=dc_norm(j,i)
12586 dxnorm_safe(j)=dc_norm(j,i+nres)
12589 c(j,i)=ddc(j)+aincr
12590 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
12591 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
12592 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12593 dc(j,i)=c(j,i+1)-c(j,i)
12594 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12595 call int_from_cart1(.false.)
12596 if (.not.split_ene) then
12598 call etotal(energia1)
12600 write (iout,*) "ij",i,j," etot1",etot1
12603 call etotal_long(energia1)
12605 call etotal_short(energia1)
12608 !- end split gradient
12609 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12610 c(j,i)=ddc(j)-aincr
12611 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
12612 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
12613 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12614 dc(j,i)=c(j,i+1)-c(j,i)
12615 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12616 call int_from_cart1(.false.)
12617 if (.not.split_ene) then
12619 call etotal(energia1)
12621 write (iout,*) "ij",i,j," etot2",etot2
12622 ggg(j)=(etot1-etot2)/(2*aincr)
12625 call etotal_long(energia1)
12627 ggg(j)=(etot11-etot21)/(2*aincr)
12628 call etotal_short(energia1)
12630 ggg1(j)=(etot12-etot22)/(2*aincr)
12631 !- end split gradient
12632 ! write (iout,*) "etot21",etot21," etot22",etot22
12634 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12636 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
12637 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
12638 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12639 dc(j,i)=c(j,i+1)-c(j,i)
12640 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12641 dc_norm(j,i-1)=dcnorm_safe1(j)
12642 dc_norm(j,i)=dcnorm_safe2(j)
12643 dc_norm(j,i+nres)=dxnorm_safe(j)
12646 c(j,i+nres)=ddx(j)+aincr
12647 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12648 call int_from_cart1(.false.)
12649 if (.not.split_ene) then
12651 call etotal(energia1)
12655 call etotal_long(energia1)
12657 call etotal_short(energia1)
12660 !- end split gradient
12661 c(j,i+nres)=ddx(j)-aincr
12662 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12663 call int_from_cart1(.false.)
12664 if (.not.split_ene) then
12666 call etotal(energia1)
12668 ggg(j+3)=(etot1-etot2)/(2*aincr)
12671 call etotal_long(energia1)
12673 ggg(j+3)=(etot11-etot21)/(2*aincr)
12674 call etotal_short(energia1)
12676 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12677 !- end split gradient
12679 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12681 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12682 dc_norm(j,i+nres)=dxnorm_safe(j)
12683 call int_from_cart1(.false.)
12685 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12686 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12687 if (split_ene) then
12688 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12689 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12691 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12692 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12693 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12697 end subroutine check_ecartint
12699 !-----------------------------------------------------------------------------
12700 subroutine check_ecartint
12701 ! Check the gradient of the energy in Cartesian coordinates.
12702 use io_base, only: intout
12703 ! implicit real*8 (a-h,o-z)
12704 ! include 'DIMENSIONS'
12705 ! include 'COMMON.CONTROL'
12706 ! include 'COMMON.CHAIN'
12707 ! include 'COMMON.DERIV'
12708 ! include 'COMMON.IOUNITS'
12709 ! include 'COMMON.VAR'
12710 ! include 'COMMON.CONTACTS'
12711 ! include 'COMMON.MD'
12712 ! include 'COMMON.LOCAL'
12713 ! include 'COMMON.SPLITELE'
12715 !el integer :: icall
12716 !el common /srutu/ icall
12717 real(kind=8),dimension(6) :: ggg,ggg1
12718 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12719 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12720 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
12721 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12722 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12723 real(kind=8),dimension(0:n_ene) :: energia,energia1
12724 integer :: uiparm(1)
12725 real(kind=8) :: urparm(1)
12727 integer :: i,j,k,nf
12728 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12736 ! call intcartderiv
12737 ! call checkintcartgrad
12740 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
12743 call geom_to_var(nvar,x)
12744 if (.not.split_ene) then
12745 call etotal(energia)
12747 !el call enerprint(energia)
12751 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12754 grad_s(j,0)=gcart(j,0)
12758 grad_s(j,i)=gcart(j,i)
12759 grad_s(j+3,i)=gxcart(j,i)
12762 write(iout,*) "before movement analytical gradient"
12764 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12765 (gxcart(j,i),j=1,3)
12769 !- split gradient check
12771 call etotal_long(energia)
12772 !el call enerprint(energia)
12776 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12777 (gxcart(j,i),j=1,3)
12780 grad_s(j,0)=gcart(j,0)
12784 grad_s(j,i)=gcart(j,i)
12785 ! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
12786 grad_s(j+3,i)=gxcart(j,i)
12790 call etotal_short(energia)
12791 !el call enerprint(energia)
12795 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12796 (gxcart(j,i),j=1,3)
12799 grad_s1(j,0)=gcart(j,0)
12803 grad_s1(j,i)=gcart(j,i)
12804 grad_s1(j+3,i)=gxcart(j,i)
12808 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12813 ddx(j)=dc(j,i+nres)
12815 dcnorm_safe(k)=dc_norm(k,i)
12816 dxnorm_safe(k)=dc_norm(k,i+nres)
12820 dc(j,i)=ddc(j)+aincr
12821 call chainbuild_cart
12823 ! Broadcast the order to compute internal coordinates to the slaves.
12824 ! if (nfgtasks.gt.1)
12825 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12827 ! call int_from_cart1(.false.)
12828 if (.not.split_ene) then
12830 call etotal(energia1)
12832 ! call enerprint(energia1)
12835 call etotal_long(energia1)
12837 call etotal_short(energia1)
12839 ! write (iout,*) "etot11",etot11," etot12",etot12
12841 !- end split gradient
12842 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12843 dc(j,i)=ddc(j)-aincr
12844 call chainbuild_cart
12845 ! call int_from_cart1(.false.)
12846 if (.not.split_ene) then
12848 call etotal(energia1)
12850 ggg(j)=(etot1-etot2)/(2*aincr)
12853 call etotal_long(energia1)
12855 ggg(j)=(etot11-etot21)/(2*aincr)
12856 call etotal_short(energia1)
12858 ggg1(j)=(etot12-etot22)/(2*aincr)
12859 !- end split gradient
12860 ! write (iout,*) "etot21",etot21," etot22",etot22
12862 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12864 call chainbuild_cart
12867 dc(j,i+nres)=ddx(j)+aincr
12868 call chainbuild_cart
12869 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
12870 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12871 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12872 ! write (iout,*) "dxnormnorm",dsqrt(
12873 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12874 ! write (iout,*) "dxnormnormsafe",dsqrt(
12875 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12877 if (.not.split_ene) then
12879 call etotal(energia1)
12883 call etotal_long(energia1)
12885 call etotal_short(energia1)
12888 !- end split gradient
12889 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12890 dc(j,i+nres)=ddx(j)-aincr
12891 call chainbuild_cart
12892 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
12893 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12894 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12896 ! write (iout,*) "dxnormnorm",dsqrt(
12897 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12898 ! write (iout,*) "dxnormnormsafe",dsqrt(
12899 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12900 if (.not.split_ene) then
12902 call etotal(energia1)
12904 ggg(j+3)=(etot1-etot2)/(2*aincr)
12907 call etotal_long(energia1)
12909 ggg(j+3)=(etot11-etot21)/(2*aincr)
12910 call etotal_short(energia1)
12912 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12913 !- end split gradient
12915 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12916 dc(j,i+nres)=ddx(j)
12917 call chainbuild_cart
12919 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12920 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12921 if (split_ene) then
12922 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12923 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12925 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12926 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12927 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12931 end subroutine check_ecartint
12933 !-----------------------------------------------------------------------------
12934 subroutine check_eint
12935 ! Check the gradient of energy in internal coordinates.
12936 ! implicit real*8 (a-h,o-z)
12937 ! include 'DIMENSIONS'
12938 ! include 'COMMON.CHAIN'
12939 ! include 'COMMON.DERIV'
12940 ! include 'COMMON.IOUNITS'
12941 ! include 'COMMON.VAR'
12942 ! include 'COMMON.GEO'
12944 !el integer :: icall
12945 !el common /srutu/ icall
12946 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
12947 integer :: uiparm(1)
12948 real(kind=8) :: urparm(1)
12949 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
12950 character(len=6) :: key
12953 real(kind=8) :: xi,aincr,etot,etot1,etot2
12956 print '(a)','Calling CHECK_INT.'
12960 call geom_to_var(nvar,x)
12961 call var_to_geom(nvar,x)
12964 ! print *,'ICG=',ICG
12965 call etotal(energia)
12967 !el call enerprint(energia)
12968 ! print *,'ICG=',ICG
12970 if (MyID.ne.BossID) then
12971 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
12979 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
12980 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
12981 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
12985 x(i)=xi-0.5D0*aincr
12986 call var_to_geom(nvar,x)
12988 call etotal(energia1)
12990 x(i)=xi+0.5D0*aincr
12991 call var_to_geom(nvar,x)
12993 call etotal(energia2)
12995 gg(i)=(etot2-etot1)/aincr
12996 write (iout,*) i,etot1,etot2
12999 write (iout,'(/2a)')' Variable Numerical Analytical',&
13002 if (i.le.nphi) then
13005 else if (i.le.nphi+ntheta) then
13008 else if (i.le.nphi+ntheta+nside) then
13012 ii=i-(nphi+ntheta+nside)
13015 write (iout,'(i3,a,i3,3(1pd16.6))') &
13016 i,key,ii,gg(i),gana(i),&
13017 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
13020 end subroutine check_eint
13021 !-----------------------------------------------------------------------------
13023 !-----------------------------------------------------------------------------
13024 subroutine Econstr_back
13025 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
13026 ! implicit real*8 (a-h,o-z)
13027 ! include 'DIMENSIONS'
13028 ! include 'COMMON.CONTROL'
13029 ! include 'COMMON.VAR'
13030 ! include 'COMMON.MD'
13033 ! include 'COMMON.LANGEVIN'
13035 ! include 'COMMON.LANGEVIN.lang0'
13037 ! include 'COMMON.CHAIN'
13038 ! include 'COMMON.DERIV'
13039 ! include 'COMMON.GEO'
13040 ! include 'COMMON.LOCAL'
13041 ! include 'COMMON.INTERACT'
13042 ! include 'COMMON.IOUNITS'
13043 ! include 'COMMON.NAMES'
13044 ! include 'COMMON.TIME1'
13045 integer :: i,j,ii,k
13046 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
13048 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
13049 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
13050 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
13057 duscdiff(j,i)=0.0d0
13058 duscdiffx(j,i)=0.0d0
13062 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
13064 ! Deviations from theta angles
13067 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
13068 dtheta_i=theta(j)-thetaref(j)
13069 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
13070 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
13072 utheta(i)=utheta_i/(ii-1)
13074 ! Deviations from gamma angles
13077 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
13078 dgamma_i=pinorm(phi(j)-phiref(j))
13079 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
13080 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
13081 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
13082 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
13084 ugamma(i)=ugamma_i/(ii-2)
13086 ! Deviations from local SC geometry
13089 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
13090 dxx=xxtab(j)-xxref(j)
13091 dyy=yytab(j)-yyref(j)
13092 dzz=zztab(j)-zzref(j)
13093 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
13095 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
13096 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
13098 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
13099 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
13101 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
13102 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
13105 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
13106 ! & xxref(j),yyref(j),zzref(j)
13108 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
13109 ! write (iout,*) i," uscdiff",uscdiff(i)
13111 ! Put together deviations from local geometry
13113 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
13114 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
13115 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
13116 ! & " uconst_back",uconst_back
13117 utheta(i)=dsqrt(utheta(i))
13118 ugamma(i)=dsqrt(ugamma(i))
13119 uscdiff(i)=dsqrt(uscdiff(i))
13122 end subroutine Econstr_back
13123 !-----------------------------------------------------------------------------
13124 ! energy_p_new-sep_barrier.F
13125 !-----------------------------------------------------------------------------
13126 real(kind=8) function sscale(r)
13127 ! include "COMMON.SPLITELE"
13128 real(kind=8) :: r,gamm
13129 if(r.lt.r_cut-rlamb) then
13131 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
13132 gamm=(r-(r_cut-rlamb))/rlamb
13133 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
13138 end function sscale
13139 real(kind=8) function sscale_grad(r)
13140 ! include "COMMON.SPLITELE"
13141 real(kind=8) :: r,gamm
13142 if(r.lt.r_cut-rlamb) then
13144 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
13145 gamm=(r-(r_cut-rlamb))/rlamb
13146 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
13151 end function sscale_grad
13153 !!!!!!!!!! PBCSCALE
13154 real(kind=8) function sscale_ele(r)
13155 ! include "COMMON.SPLITELE"
13156 real(kind=8) :: r,gamm
13157 if(r.lt.r_cut_ele-rlamb_ele) then
13159 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
13160 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
13161 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
13166 end function sscale_ele
13168 real(kind=8) function sscagrad_ele(r)
13169 real(kind=8) :: r,gamm
13170 ! include "COMMON.SPLITELE"
13171 if(r.lt.r_cut_ele-rlamb_ele) then
13173 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
13174 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
13175 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
13180 end function sscagrad_ele
13181 real(kind=8) function sscalelip(r)
13182 real(kind=8) r,gamm
13183 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
13185 end function sscalelip
13186 !C-----------------------------------------------------------------------
13187 real(kind=8) function sscagradlip(r)
13188 real(kind=8) r,gamm
13189 sscagradlip=r*(6.0d0*r-6.0d0)
13191 end function sscagradlip
13194 !-----------------------------------------------------------------------------
13195 subroutine elj_long(evdw)
13197 ! This subroutine calculates the interaction energy of nonbonded side chains
13198 ! assuming the LJ potential of interaction.
13200 ! implicit real*8 (a-h,o-z)
13201 ! include 'DIMENSIONS'
13202 ! include 'COMMON.GEO'
13203 ! include 'COMMON.VAR'
13204 ! include 'COMMON.LOCAL'
13205 ! include 'COMMON.CHAIN'
13206 ! include 'COMMON.DERIV'
13207 ! include 'COMMON.INTERACT'
13208 ! include 'COMMON.TORSION'
13209 ! include 'COMMON.SBRIDGE'
13210 ! include 'COMMON.NAMES'
13211 ! include 'COMMON.IOUNITS'
13212 ! include 'COMMON.CONTACTS'
13213 real(kind=8),parameter :: accur=1.0d-10
13214 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13215 !el local variables
13216 integer :: i,iint,j,k,itypi,itypi1,itypj
13217 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
13218 real(kind=8) :: e1,e2,evdwij,evdw,sslipi,ssgradlipi,&
13219 sslipj,ssgradlipj,aa,bb
13220 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
13222 do i=iatsc_s,iatsc_e
13224 if (itypi.eq.ntyp1) cycle
13225 itypi1=itype(i+1,1)
13229 call to_box(xi,yi,zi)
13230 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
13232 ! Calculate SC interaction energy.
13234 do iint=1,nint_gr(i)
13235 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
13236 !d & 'iend=',iend(i,iint)
13237 do j=istart(i,iint),iend(i,iint)
13239 if (itypj.eq.ntyp1) cycle
13243 call to_box(xj,yj,zj)
13244 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
13245 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13246 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13247 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13248 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13249 xj=boxshift(xj-xi,boxxsize)
13250 yj=boxshift(yj-yi,boxysize)
13251 zj=boxshift(zj-zi,boxzsize)
13252 rij=xj*xj+yj*yj+zj*zj
13253 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
13254 if (sss.lt.1.0d0) then
13256 eps0ij=eps(itypi,itypj)
13258 e1=fac*fac*aa_aq(itypi,itypj)
13259 e2=fac*bb_aq(itypi,itypj)
13261 evdw=evdw+(1.0d0-sss)*evdwij
13263 ! Calculate the components of the gradient in DC and X
13265 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
13270 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13271 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13272 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13273 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13281 gvdwc(j,i)=expon*gvdwc(j,i)
13282 gvdwx(j,i)=expon*gvdwx(j,i)
13285 !******************************************************************************
13289 ! To save time, the factor of EXPON has been extracted from ALL components
13290 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13293 !******************************************************************************
13295 end subroutine elj_long
13296 !-----------------------------------------------------------------------------
13297 subroutine elj_short(evdw)
13299 ! This subroutine calculates the interaction energy of nonbonded side chains
13300 ! assuming the LJ potential of interaction.
13302 ! implicit real*8 (a-h,o-z)
13303 ! include 'DIMENSIONS'
13304 ! include 'COMMON.GEO'
13305 ! include 'COMMON.VAR'
13306 ! include 'COMMON.LOCAL'
13307 ! include 'COMMON.CHAIN'
13308 ! include 'COMMON.DERIV'
13309 ! include 'COMMON.INTERACT'
13310 ! include 'COMMON.TORSION'
13311 ! include 'COMMON.SBRIDGE'
13312 ! include 'COMMON.NAMES'
13313 ! include 'COMMON.IOUNITS'
13314 ! include 'COMMON.CONTACTS'
13315 real(kind=8),parameter :: accur=1.0d-10
13316 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13317 !el local variables
13318 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
13319 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
13320 real(kind=8) :: e1,e2,evdwij,evdw,sslipi,ssgradlipi,&
13322 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
13324 do i=iatsc_s,iatsc_e
13326 if (itypi.eq.ntyp1) cycle
13327 itypi1=itype(i+1,1)
13331 call to_box(xi,yi,zi)
13332 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
13336 ! Calculate SC interaction energy.
13338 do iint=1,nint_gr(i)
13339 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
13340 !d & 'iend=',iend(i,iint)
13341 do j=istart(i,iint),iend(i,iint)
13343 if (itypj.eq.ntyp1) cycle
13347 ! Change 12/1/95 to calculate four-body interactions
13348 rij=xj*xj+yj*yj+zj*zj
13349 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
13350 if (sss.gt.0.0d0) then
13352 eps0ij=eps(itypi,itypj)
13354 e1=fac*fac*aa_aq(itypi,itypj)
13355 e2=fac*bb_aq(itypi,itypj)
13357 evdw=evdw+sss*evdwij
13359 ! Calculate the components of the gradient in DC and X
13361 fac=-rrij*(e1+evdwij)*sss
13366 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13367 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13368 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13369 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13377 gvdwc(j,i)=expon*gvdwc(j,i)
13378 gvdwx(j,i)=expon*gvdwx(j,i)
13381 !******************************************************************************
13385 ! To save time, the factor of EXPON has been extracted from ALL components
13386 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13389 !******************************************************************************
13391 end subroutine elj_short
13392 !-----------------------------------------------------------------------------
13393 subroutine eljk_long(evdw)
13395 ! This subroutine calculates the interaction energy of nonbonded side chains
13396 ! assuming the LJK potential of interaction.
13398 ! implicit real*8 (a-h,o-z)
13399 ! include 'DIMENSIONS'
13400 ! include 'COMMON.GEO'
13401 ! include 'COMMON.VAR'
13402 ! include 'COMMON.LOCAL'
13403 ! include 'COMMON.CHAIN'
13404 ! include 'COMMON.DERIV'
13405 ! include 'COMMON.INTERACT'
13406 ! include 'COMMON.IOUNITS'
13407 ! include 'COMMON.NAMES'
13408 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13410 !el local variables
13411 integer :: i,iint,j,k,itypi,itypi1,itypj
13412 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
13413 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
13414 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
13416 do i=iatsc_s,iatsc_e
13418 if (itypi.eq.ntyp1) cycle
13419 itypi1=itype(i+1,1)
13423 call to_box(xi,yi,zi)
13426 ! Calculate SC interaction energy.
13428 do iint=1,nint_gr(i)
13429 do j=istart(i,iint),iend(i,iint)
13431 if (itypj.eq.ntyp1) cycle
13435 call to_box(xj,yj,zj)
13436 xj=boxshift(xj-xi,boxxsize)
13437 yj=boxshift(yj-yi,boxysize)
13438 zj=boxshift(zj-zi,boxzsize)
13440 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13441 fac_augm=rrij**expon
13442 e_augm=augm(itypi,itypj)*fac_augm
13443 r_inv_ij=dsqrt(rrij)
13445 sss=sscale(rij/sigma(itypi,itypj))
13446 if (sss.lt.1.0d0) then
13447 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
13448 fac=r_shift_inv**expon
13449 e1=fac*fac*aa_aq(itypi,itypj)
13450 e2=fac*bb_aq(itypi,itypj)
13451 evdwij=e_augm+e1+e2
13452 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
13453 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
13454 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
13455 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
13456 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
13457 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
13458 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
13459 evdw=evdw+(1.0d0-sss)*evdwij
13461 ! Calculate the components of the gradient in DC and X
13463 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
13464 fac=fac*(1.0d0-sss)
13469 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13470 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13471 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13472 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13480 gvdwc(j,i)=expon*gvdwc(j,i)
13481 gvdwx(j,i)=expon*gvdwx(j,i)
13485 end subroutine eljk_long
13486 !-----------------------------------------------------------------------------
13487 subroutine eljk_short(evdw)
13489 ! This subroutine calculates the interaction energy of nonbonded side chains
13490 ! assuming the LJK potential of interaction.
13492 ! implicit real*8 (a-h,o-z)
13493 ! include 'DIMENSIONS'
13494 ! include 'COMMON.GEO'
13495 ! include 'COMMON.VAR'
13496 ! include 'COMMON.LOCAL'
13497 ! include 'COMMON.CHAIN'
13498 ! include 'COMMON.DERIV'
13499 ! include 'COMMON.INTERACT'
13500 ! include 'COMMON.IOUNITS'
13501 ! include 'COMMON.NAMES'
13502 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13504 !el local variables
13505 integer :: i,iint,j,k,itypi,itypi1,itypj
13506 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
13507 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij,&
13508 sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
13509 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
13511 do i=iatsc_s,iatsc_e
13513 if (itypi.eq.ntyp1) cycle
13514 itypi1=itype(i+1,1)
13518 call to_box(xi,yi,zi)
13519 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
13521 ! Calculate SC interaction energy.
13523 do iint=1,nint_gr(i)
13524 do j=istart(i,iint),iend(i,iint)
13526 if (itypj.eq.ntyp1) cycle
13530 call to_box(xj,yj,zj)
13531 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
13532 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13533 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13534 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13535 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13536 xj=boxshift(xj-xi,boxxsize)
13537 yj=boxshift(yj-yi,boxysize)
13538 zj=boxshift(zj-zi,boxzsize)
13539 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13540 fac_augm=rrij**expon
13541 e_augm=augm(itypi,itypj)*fac_augm
13542 r_inv_ij=dsqrt(rrij)
13544 sss=sscale(rij/sigma(itypi,itypj))
13545 if (sss.gt.0.0d0) then
13546 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
13547 fac=r_shift_inv**expon
13548 e1=fac*fac*aa_aq(itypi,itypj)
13549 e2=fac*bb_aq(itypi,itypj)
13550 evdwij=e_augm+e1+e2
13551 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
13552 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
13553 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
13554 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
13555 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
13556 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
13557 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
13558 evdw=evdw+sss*evdwij
13560 ! Calculate the components of the gradient in DC and X
13562 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
13568 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13569 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13570 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13571 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13579 gvdwc(j,i)=expon*gvdwc(j,i)
13580 gvdwx(j,i)=expon*gvdwx(j,i)
13584 end subroutine eljk_short
13585 !-----------------------------------------------------------------------------
13586 subroutine ebp_long(evdw)
13587 ! This subroutine calculates the interaction energy of nonbonded side chains
13588 ! assuming the Berne-Pechukas potential of interaction.
13591 ! implicit real*8 (a-h,o-z)
13592 ! include 'DIMENSIONS'
13593 ! include 'COMMON.GEO'
13594 ! include 'COMMON.VAR'
13595 ! include 'COMMON.LOCAL'
13596 ! include 'COMMON.CHAIN'
13597 ! include 'COMMON.DERIV'
13598 ! include 'COMMON.NAMES'
13599 ! include 'COMMON.INTERACT'
13600 ! include 'COMMON.IOUNITS'
13601 ! include 'COMMON.CALC'
13603 !el integer :: icall
13604 !el common /srutu/ icall
13605 ! double precision rrsave(maxdim)
13607 !el local variables
13608 integer :: iint,itypi,itypi1,itypj
13609 real(kind=8) :: rrij,xi,yi,zi,fac,sslipi,ssgradlipi,&
13610 sslipj,ssgradlipj,aa,bb
13611 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
13613 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13615 ! if (icall.eq.0) then
13621 do i=iatsc_s,iatsc_e
13623 if (itypi.eq.ntyp1) cycle
13624 itypi1=itype(i+1,1)
13628 call to_box(xi,yi,zi)
13629 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
13630 dxi=dc_norm(1,nres+i)
13631 dyi=dc_norm(2,nres+i)
13632 dzi=dc_norm(3,nres+i)
13633 ! dsci_inv=dsc_inv(itypi)
13634 dsci_inv=vbld_inv(i+nres)
13636 ! Calculate SC interaction energy.
13638 do iint=1,nint_gr(i)
13639 do j=istart(i,iint),iend(i,iint)
13642 if (itypj.eq.ntyp1) cycle
13643 ! dscj_inv=dsc_inv(itypj)
13644 dscj_inv=vbld_inv(j+nres)
13645 chi1=chi(itypi,itypj)
13646 chi2=chi(itypj,itypi)
13651 alf12=0.5D0*(alf1+alf2)
13655 call to_box(xj,yj,zj)
13656 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
13657 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13658 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13659 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13660 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13661 xj=boxshift(xj-xi,boxxsize)
13662 yj=boxshift(yj-yi,boxysize)
13663 zj=boxshift(zj-zi,boxzsize)
13664 dxj=dc_norm(1,nres+j)
13665 dyj=dc_norm(2,nres+j)
13666 dzj=dc_norm(3,nres+j)
13667 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13669 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13671 if (sss.lt.1.0d0) then
13673 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13675 ! Calculate whole angle-dependent part of epsilon and contributions
13676 ! to its derivatives
13677 fac=(rrij*sigsq)**expon2
13678 e1=fac*fac*aa_aq(itypi,itypj)
13679 e2=fac*bb_aq(itypi,itypj)
13680 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13681 eps2der=evdwij*eps3rt
13682 eps3der=evdwij*eps2rt
13683 evdwij=evdwij*eps2rt*eps3rt
13684 evdw=evdw+evdwij*(1.0d0-sss)
13686 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13687 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13688 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13689 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13690 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13691 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13692 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13695 ! Calculate gradient components.
13696 e1=e1*eps1*eps2rt**2*eps3rt**2
13697 fac=-expon*(e1+evdwij)
13700 ! Calculate radial part of the gradient
13704 ! Calculate the angular part of the gradient and sum add the contributions
13705 ! to the appropriate components of the Cartesian gradient.
13706 call sc_grad_scale(1.0d0-sss)
13713 end subroutine ebp_long
13714 !-----------------------------------------------------------------------------
13715 subroutine ebp_short(evdw)
13717 ! This subroutine calculates the interaction energy of nonbonded side chains
13718 ! assuming the Berne-Pechukas potential of interaction.
13721 ! implicit real*8 (a-h,o-z)
13722 ! include 'DIMENSIONS'
13723 ! include 'COMMON.GEO'
13724 ! include 'COMMON.VAR'
13725 ! include 'COMMON.LOCAL'
13726 ! include 'COMMON.CHAIN'
13727 ! include 'COMMON.DERIV'
13728 ! include 'COMMON.NAMES'
13729 ! include 'COMMON.INTERACT'
13730 ! include 'COMMON.IOUNITS'
13731 ! include 'COMMON.CALC'
13733 !el integer :: icall
13734 !el common /srutu/ icall
13735 ! double precision rrsave(maxdim)
13737 !el local variables
13738 integer :: iint,itypi,itypi1,itypj
13739 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
13740 real(kind=8) :: sss,e1,e2,evdw,aa,bb, &
13741 sslipi,ssgradlipi,sslipj,ssgradlipj
13743 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13745 ! if (icall.eq.0) then
13751 do i=iatsc_s,iatsc_e
13753 if (itypi.eq.ntyp1) cycle
13754 itypi1=itype(i+1,1)
13758 call to_box(xi,yi,zi)
13759 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
13761 dxi=dc_norm(1,nres+i)
13762 dyi=dc_norm(2,nres+i)
13763 dzi=dc_norm(3,nres+i)
13764 ! dsci_inv=dsc_inv(itypi)
13765 dsci_inv=vbld_inv(i+nres)
13767 ! Calculate SC interaction energy.
13769 do iint=1,nint_gr(i)
13770 do j=istart(i,iint),iend(i,iint)
13773 if (itypj.eq.ntyp1) cycle
13774 ! dscj_inv=dsc_inv(itypj)
13775 dscj_inv=vbld_inv(j+nres)
13776 chi1=chi(itypi,itypj)
13777 chi2=chi(itypj,itypi)
13784 alf12=0.5D0*(alf1+alf2)
13788 call to_box(xj,yj,zj)
13789 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
13790 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13791 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13792 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13793 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13794 xj=boxshift(xj-xi,boxxsize)
13795 yj=boxshift(yj-yi,boxysize)
13796 zj=boxshift(zj-zi,boxzsize)
13797 dxj=dc_norm(1,nres+j)
13798 dyj=dc_norm(2,nres+j)
13799 dzj=dc_norm(3,nres+j)
13800 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13802 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13804 if (sss.gt.0.0d0) then
13806 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13808 ! Calculate whole angle-dependent part of epsilon and contributions
13809 ! to its derivatives
13810 fac=(rrij*sigsq)**expon2
13811 e1=fac*fac*aa_aq(itypi,itypj)
13812 e2=fac*bb_aq(itypi,itypj)
13813 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13814 eps2der=evdwij*eps3rt
13815 eps3der=evdwij*eps2rt
13816 evdwij=evdwij*eps2rt*eps3rt
13817 evdw=evdw+evdwij*sss
13819 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13820 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13821 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13822 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13823 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13824 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13825 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13828 ! Calculate gradient components.
13829 e1=e1*eps1*eps2rt**2*eps3rt**2
13830 fac=-expon*(e1+evdwij)
13833 ! Calculate radial part of the gradient
13837 ! Calculate the angular part of the gradient and sum add the contributions
13838 ! to the appropriate components of the Cartesian gradient.
13839 call sc_grad_scale(sss)
13846 end subroutine ebp_short
13847 !-----------------------------------------------------------------------------
13848 subroutine egb_long(evdw)
13850 ! This subroutine calculates the interaction energy of nonbonded side chains
13851 ! assuming the Gay-Berne potential of interaction.
13854 ! implicit real*8 (a-h,o-z)
13855 ! include 'DIMENSIONS'
13856 ! include 'COMMON.GEO'
13857 ! include 'COMMON.VAR'
13858 ! include 'COMMON.LOCAL'
13859 ! include 'COMMON.CHAIN'
13860 ! include 'COMMON.DERIV'
13861 ! include 'COMMON.NAMES'
13862 ! include 'COMMON.INTERACT'
13863 ! include 'COMMON.IOUNITS'
13864 ! include 'COMMON.CALC'
13865 ! include 'COMMON.CONTROL'
13867 !el local variables
13868 integer :: iint,itypi,itypi1,itypj,subchap
13869 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13870 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13871 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13872 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13873 ssgradlipi,ssgradlipj
13877 !cccc energy_dec=.false.
13878 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13881 ! if (icall.eq.0) lprn=.false.
13883 do i=iatsc_s,iatsc_e
13885 if (itypi.eq.ntyp1) cycle
13886 itypi1=itype(i+1,1)
13890 call to_box(xi,yi,zi)
13891 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
13892 dxi=dc_norm(1,nres+i)
13893 dyi=dc_norm(2,nres+i)
13894 dzi=dc_norm(3,nres+i)
13895 ! dsci_inv=dsc_inv(itypi)
13896 dsci_inv=vbld_inv(i+nres)
13897 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13898 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13900 ! Calculate SC interaction energy.
13902 do iint=1,nint_gr(i)
13903 do j=istart(i,iint),iend(i,iint)
13904 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13905 ! call dyn_ssbond_ene(i,j,evdwij)
13907 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13908 ! 'evdw',i,j,evdwij,' ss'
13909 ! if (energy_dec) write (iout,*) &
13910 ! 'evdw',i,j,evdwij,' ss'
13911 ! do k=j+1,iend(i,iint)
13912 !C search over all next residues
13913 ! if (dyn_ss_mask(k)) then
13914 !C check if they are cysteins
13915 !C write(iout,*) 'k=',k
13917 !c write(iout,*) "PRZED TRI", evdwij
13918 ! evdwij_przed_tri=evdwij
13919 ! call triple_ssbond_ene(i,j,k,evdwij)
13920 !c if(evdwij_przed_tri.ne.evdwij) then
13921 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13924 !c write(iout,*) "PO TRI", evdwij
13925 !C call the energy function that removes the artifical triple disulfide
13926 !C bond the soubroutine is located in ssMD.F
13928 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13929 'evdw',i,j,evdwij,'tss'
13930 ! endif!dyn_ss_mask(k)
13936 if (itypj.eq.ntyp1) cycle
13937 ! dscj_inv=dsc_inv(itypj)
13938 dscj_inv=vbld_inv(j+nres)
13939 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13940 ! & 1.0d0/vbld(j+nres)
13941 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13942 sig0ij=sigma(itypi,itypj)
13943 chi1=chi(itypi,itypj)
13944 chi2=chi(itypj,itypi)
13951 alf12=0.5D0*(alf1+alf2)
13955 ! Searching for nearest neighbour
13956 call to_box(xj,yj,zj)
13957 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
13958 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13959 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13960 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13961 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13962 xj=boxshift(xj-xi,boxxsize)
13963 yj=boxshift(yj-yi,boxysize)
13964 zj=boxshift(zj-zi,boxzsize)
13965 dxj=dc_norm(1,nres+j)
13966 dyj=dc_norm(2,nres+j)
13967 dzj=dc_norm(3,nres+j)
13968 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13970 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13971 sss_ele_cut=sscale_ele(1.0d0/(rij))
13972 sss_ele_grad=sscagrad_ele(1.0d0/(rij))
13973 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13974 if (sss_ele_cut.le.0.0) cycle
13975 if (sss.lt.1.0d0) then
13977 ! Calculate angle-dependent terms of energy and contributions to their
13981 sig=sig0ij*dsqrt(sigsq)
13982 rij_shift=1.0D0/rij-sig+sig0ij
13983 ! for diagnostics; uncomment
13984 ! rij_shift=1.2*sig0ij
13985 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13986 if (rij_shift.le.0.0D0) then
13988 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13989 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13990 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13994 !---------------------------------------------------------------
13995 rij_shift=1.0D0/rij_shift
13996 fac=rij_shift**expon
13999 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14000 eps2der=evdwij*eps3rt
14001 eps3der=evdwij*eps2rt
14002 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
14003 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
14004 evdwij=evdwij*eps2rt*eps3rt
14005 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
14007 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14008 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14009 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14010 restyp(itypi,1),i,restyp(itypj,1),j,&
14011 epsi,sigm,chi1,chi2,chip1,chip2,&
14012 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
14013 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14017 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14019 ! if (energy_dec) write (iout,*) &
14020 ! 'evdw',i,j,evdwij,"egb_long"
14022 ! Calculate gradient components.
14023 e1=e1*eps1*eps2rt**2*eps3rt**2
14024 fac=-expon*(e1+evdwij)*rij_shift
14027 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
14028 *rij-sss_grad/(1.0-sss)*rij &
14029 /sigmaii(itypi,itypj))
14031 ! Calculate the radial part of the gradient
14035 ! Calculate angular part of the gradient.
14036 call sc_grad_scale(1.0d0-sss)
14042 ! write (iout,*) "Number of loop steps in EGB:",ind
14043 !ccc energy_dec=.false.
14045 end subroutine egb_long
14046 !-----------------------------------------------------------------------------
14047 subroutine egb_short(evdw)
14049 ! This subroutine calculates the interaction energy of nonbonded side chains
14050 ! assuming the Gay-Berne potential of interaction.
14053 ! implicit real*8 (a-h,o-z)
14054 ! include 'DIMENSIONS'
14055 ! include 'COMMON.GEO'
14056 ! include 'COMMON.VAR'
14057 ! include 'COMMON.LOCAL'
14058 ! include 'COMMON.CHAIN'
14059 ! include 'COMMON.DERIV'
14060 ! include 'COMMON.NAMES'
14061 ! include 'COMMON.INTERACT'
14062 ! include 'COMMON.IOUNITS'
14063 ! include 'COMMON.CALC'
14064 ! include 'COMMON.CONTROL'
14066 !el local variables
14067 integer :: iint,itypi,itypi1,itypj,subchap
14068 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
14069 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
14070 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14071 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
14072 ssgradlipi,ssgradlipj
14074 !cccc energy_dec=.false.
14075 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14078 ! if (icall.eq.0) lprn=.false.
14080 do i=iatsc_s,iatsc_e
14082 if (itypi.eq.ntyp1) cycle
14083 itypi1=itype(i+1,1)
14087 call to_box(xi,yi,zi)
14088 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
14090 dxi=dc_norm(1,nres+i)
14091 dyi=dc_norm(2,nres+i)
14092 dzi=dc_norm(3,nres+i)
14093 ! dsci_inv=dsc_inv(itypi)
14094 dsci_inv=vbld_inv(i+nres)
14096 dxi=dc_norm(1,nres+i)
14097 dyi=dc_norm(2,nres+i)
14098 dzi=dc_norm(3,nres+i)
14099 ! dsci_inv=dsc_inv(itypi)
14100 dsci_inv=vbld_inv(i+nres)
14101 do iint=1,nint_gr(i)
14102 do j=istart(i,iint),iend(i,iint)
14103 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
14104 call dyn_ssbond_ene(i,j,evdwij)
14106 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14107 'evdw',i,j,evdwij,' ss'
14108 do k=j+1,iend(i,iint)
14109 !C search over all next residues
14110 if (dyn_ss_mask(k)) then
14111 !C check if they are cysteins
14112 !C write(iout,*) 'k=',k
14114 !c write(iout,*) "PRZED TRI", evdwij
14115 ! evdwij_przed_tri=evdwij
14116 call triple_ssbond_ene(i,j,k,evdwij)
14117 !c if(evdwij_przed_tri.ne.evdwij) then
14118 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
14121 !c write(iout,*) "PO TRI", evdwij
14122 !C call the energy function that removes the artifical triple disulfide
14123 !C bond the soubroutine is located in ssMD.F
14125 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14126 'evdw',i,j,evdwij,'tss'
14127 endif!dyn_ss_mask(k)
14132 if (itypj.eq.ntyp1) cycle
14133 ! dscj_inv=dsc_inv(itypj)
14134 dscj_inv=vbld_inv(j+nres)
14135 dscj_inv=dsc_inv(itypj)
14136 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
14137 ! & 1.0d0/vbld(j+nres)
14138 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
14139 sig0ij=sigma(itypi,itypj)
14140 chi1=chi(itypi,itypj)
14141 chi2=chi(itypj,itypi)
14148 alf12=0.5D0*(alf1+alf2)
14149 ! xj=c(1,nres+j)-xi
14150 ! yj=c(2,nres+j)-yi
14151 ! zj=c(3,nres+j)-zi
14155 ! Searching for nearest neighbour
14156 call to_box(xj,yj,zj)
14157 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
14158 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14159 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14160 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14161 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14162 xj=boxshift(xj-xi,boxxsize)
14163 yj=boxshift(yj-yi,boxysize)
14164 zj=boxshift(zj-zi,boxzsize)
14165 dxj=dc_norm(1,nres+j)
14166 dyj=dc_norm(2,nres+j)
14167 dzj=dc_norm(3,nres+j)
14168 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14170 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14171 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
14172 sss_ele_cut=sscale_ele(1.0d0/(rij))
14173 sss_ele_grad=sscagrad_ele(1.0d0/(rij))
14174 if (sss_ele_cut.le.0.0) cycle
14176 if (sss.gt.0.0d0) then
14178 ! Calculate angle-dependent terms of energy and contributions to their
14182 sig=sig0ij*dsqrt(sigsq)
14183 rij_shift=1.0D0/rij-sig+sig0ij
14184 ! for diagnostics; uncomment
14185 ! rij_shift=1.2*sig0ij
14186 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14187 if (rij_shift.le.0.0D0) then
14189 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
14190 !d & restyp(itypi,1),i,restyp(itypj,1),j,
14191 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
14195 !---------------------------------------------------------------
14196 rij_shift=1.0D0/rij_shift
14197 fac=rij_shift**expon
14200 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14201 eps2der=evdwij*eps3rt
14202 eps3der=evdwij*eps2rt
14203 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
14204 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
14205 evdwij=evdwij*eps2rt*eps3rt
14206 evdw=evdw+evdwij*sss*sss_ele_cut
14208 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14209 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14210 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14211 restyp(itypi,1),i,restyp(itypj,1),j,&
14212 epsi,sigm,chi1,chi2,chip1,chip2,&
14213 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
14214 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14218 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14220 ! if (energy_dec) write (iout,*) &
14221 ! 'evdw',i,j,evdwij,"egb_short"
14223 ! Calculate gradient components.
14224 e1=e1*eps1*eps2rt**2*eps3rt**2
14225 fac=-expon*(e1+evdwij)*rij_shift
14228 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
14229 *rij+sss_grad/sss*rij &
14230 /sigmaii(itypi,itypj))
14233 ! Calculate the radial part of the gradient
14237 ! Calculate angular part of the gradient.
14238 call sc_grad_scale(sss)
14244 ! write (iout,*) "Number of loop steps in EGB:",ind
14245 !ccc energy_dec=.false.
14247 end subroutine egb_short
14248 !-----------------------------------------------------------------------------
14249 subroutine egbv_long(evdw)
14251 ! This subroutine calculates the interaction energy of nonbonded side chains
14252 ! assuming the Gay-Berne-Vorobjev potential of interaction.
14255 ! implicit real*8 (a-h,o-z)
14256 ! include 'DIMENSIONS'
14257 ! include 'COMMON.GEO'
14258 ! include 'COMMON.VAR'
14259 ! include 'COMMON.LOCAL'
14260 ! include 'COMMON.CHAIN'
14261 ! include 'COMMON.DERIV'
14262 ! include 'COMMON.NAMES'
14263 ! include 'COMMON.INTERACT'
14264 ! include 'COMMON.IOUNITS'
14265 ! include 'COMMON.CALC'
14267 !el integer :: icall
14268 !el common /srutu/ icall
14270 !el local variables
14271 integer :: iint,itypi,itypi1,itypj
14272 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij,&
14273 sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
14274 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
14276 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14279 ! if (icall.eq.0) lprn=.true.
14281 do i=iatsc_s,iatsc_e
14283 if (itypi.eq.ntyp1) cycle
14284 itypi1=itype(i+1,1)
14288 call to_box(xi,yi,zi)
14289 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
14290 dxi=dc_norm(1,nres+i)
14291 dyi=dc_norm(2,nres+i)
14292 dzi=dc_norm(3,nres+i)
14294 ! dsci_inv=dsc_inv(itypi)
14295 dsci_inv=vbld_inv(i+nres)
14297 ! Calculate SC interaction energy.
14299 do iint=1,nint_gr(i)
14300 do j=istart(i,iint),iend(i,iint)
14303 if (itypj.eq.ntyp1) cycle
14304 ! dscj_inv=dsc_inv(itypj)
14305 dscj_inv=vbld_inv(j+nres)
14306 sig0ij=sigma(itypi,itypj)
14307 r0ij=r0(itypi,itypj)
14308 chi1=chi(itypi,itypj)
14309 chi2=chi(itypj,itypi)
14316 alf12=0.5D0*(alf1+alf2)
14320 call to_box(xj,yj,zj)
14321 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
14322 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14323 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14324 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14325 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14326 xj=boxshift(xj-xi,boxxsize)
14327 yj=boxshift(yj-yi,boxysize)
14328 zj=boxshift(zj-zi,boxzsize)
14329 dxj=dc_norm(1,nres+j)
14330 dyj=dc_norm(2,nres+j)
14331 dzj=dc_norm(3,nres+j)
14332 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14335 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14337 if (sss.lt.1.0d0) then
14339 ! Calculate angle-dependent terms of energy and contributions to their
14343 sig=sig0ij*dsqrt(sigsq)
14344 rij_shift=1.0D0/rij-sig+r0ij
14345 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14346 if (rij_shift.le.0.0D0) then
14351 !---------------------------------------------------------------
14352 rij_shift=1.0D0/rij_shift
14353 fac=rij_shift**expon
14354 e1=fac*fac*aa_aq(itypi,itypj)
14355 e2=fac*bb_aq(itypi,itypj)
14356 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14357 eps2der=evdwij*eps3rt
14358 eps3der=evdwij*eps2rt
14359 fac_augm=rrij**expon
14360 e_augm=augm(itypi,itypj)*fac_augm
14361 evdwij=evdwij*eps2rt*eps3rt
14362 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
14364 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14365 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14366 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14367 restyp(itypi,1),i,restyp(itypj,1),j,&
14368 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
14369 chi1,chi2,chip1,chip2,&
14370 eps1,eps2rt**2,eps3rt**2,&
14371 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14374 ! Calculate gradient components.
14375 e1=e1*eps1*eps2rt**2*eps3rt**2
14376 fac=-expon*(e1+evdwij)*rij_shift
14378 fac=rij*fac-2*expon*rrij*e_augm
14379 ! Calculate the radial part of the gradient
14383 ! Calculate angular part of the gradient.
14384 call sc_grad_scale(1.0d0-sss)
14389 end subroutine egbv_long
14390 !-----------------------------------------------------------------------------
14391 subroutine egbv_short(evdw)
14393 ! This subroutine calculates the interaction energy of nonbonded side chains
14394 ! assuming the Gay-Berne-Vorobjev potential of interaction.
14397 ! implicit real*8 (a-h,o-z)
14398 ! include 'DIMENSIONS'
14399 ! include 'COMMON.GEO'
14400 ! include 'COMMON.VAR'
14401 ! include 'COMMON.LOCAL'
14402 ! include 'COMMON.CHAIN'
14403 ! include 'COMMON.DERIV'
14404 ! include 'COMMON.NAMES'
14405 ! include 'COMMON.INTERACT'
14406 ! include 'COMMON.IOUNITS'
14407 ! include 'COMMON.CALC'
14409 !el integer :: icall
14410 !el common /srutu/ icall
14412 !el local variables
14413 integer :: iint,itypi,itypi1,itypj
14414 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift,&
14415 sslipi,ssgradlipi, sslipj,ssgradlipj,aa,bb
14416 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
14418 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14421 ! if (icall.eq.0) lprn=.true.
14423 do i=iatsc_s,iatsc_e
14425 if (itypi.eq.ntyp1) cycle
14426 itypi1=itype(i+1,1)
14430 dxi=dc_norm(1,nres+i)
14431 dyi=dc_norm(2,nres+i)
14432 dzi=dc_norm(3,nres+i)
14433 call to_box(xi,yi,zi)
14434 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
14435 ! dsci_inv=dsc_inv(itypi)
14436 dsci_inv=vbld_inv(i+nres)
14438 ! Calculate SC interaction energy.
14440 do iint=1,nint_gr(i)
14441 do j=istart(i,iint),iend(i,iint)
14444 if (itypj.eq.ntyp1) cycle
14445 ! dscj_inv=dsc_inv(itypj)
14446 dscj_inv=vbld_inv(j+nres)
14447 sig0ij=sigma(itypi,itypj)
14448 r0ij=r0(itypi,itypj)
14449 chi1=chi(itypi,itypj)
14450 chi2=chi(itypj,itypi)
14457 alf12=0.5D0*(alf1+alf2)
14461 call to_box(xj,yj,zj)
14462 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
14463 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14464 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14465 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14466 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14467 xj=boxshift(xj-xi,boxxsize)
14468 yj=boxshift(yj-yi,boxysize)
14469 zj=boxshift(zj-zi,boxzsize)
14470 dxj=dc_norm(1,nres+j)
14471 dyj=dc_norm(2,nres+j)
14472 dzj=dc_norm(3,nres+j)
14473 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14476 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14478 if (sss.gt.0.0d0) then
14480 ! Calculate angle-dependent terms of energy and contributions to their
14484 sig=sig0ij*dsqrt(sigsq)
14485 rij_shift=1.0D0/rij-sig+r0ij
14486 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14487 if (rij_shift.le.0.0D0) then
14492 !---------------------------------------------------------------
14493 rij_shift=1.0D0/rij_shift
14494 fac=rij_shift**expon
14495 e1=fac*fac*aa_aq(itypi,itypj)
14496 e2=fac*bb_aq(itypi,itypj)
14497 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14498 eps2der=evdwij*eps3rt
14499 eps3der=evdwij*eps2rt
14500 fac_augm=rrij**expon
14501 e_augm=augm(itypi,itypj)*fac_augm
14502 evdwij=evdwij*eps2rt*eps3rt
14503 evdw=evdw+(evdwij+e_augm)*sss
14505 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14506 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14507 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14508 restyp(itypi,1),i,restyp(itypj,1),j,&
14509 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
14510 chi1,chi2,chip1,chip2,&
14511 eps1,eps2rt**2,eps3rt**2,&
14512 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14515 ! Calculate gradient components.
14516 e1=e1*eps1*eps2rt**2*eps3rt**2
14517 fac=-expon*(e1+evdwij)*rij_shift
14519 fac=rij*fac-2*expon*rrij*e_augm
14520 ! Calculate the radial part of the gradient
14524 ! Calculate angular part of the gradient.
14525 call sc_grad_scale(sss)
14530 end subroutine egbv_short
14531 !-----------------------------------------------------------------------------
14532 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
14534 ! This subroutine calculates the average interaction energy and its gradient
14535 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
14536 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
14537 ! The potential depends both on the distance of peptide-group centers and on
14538 ! the orientation of the CA-CA virtual bonds.
14540 ! implicit real*8 (a-h,o-z)
14546 ! include 'DIMENSIONS'
14547 ! include 'COMMON.CONTROL'
14548 ! include 'COMMON.SETUP'
14549 ! include 'COMMON.IOUNITS'
14550 ! include 'COMMON.GEO'
14551 ! include 'COMMON.VAR'
14552 ! include 'COMMON.LOCAL'
14553 ! include 'COMMON.CHAIN'
14554 ! include 'COMMON.DERIV'
14555 ! include 'COMMON.INTERACT'
14556 ! include 'COMMON.CONTACTS'
14557 ! include 'COMMON.TORSION'
14558 ! include 'COMMON.VECTORS'
14559 ! include 'COMMON.FFIELD'
14560 ! include 'COMMON.TIME1'
14561 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
14562 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
14563 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14564 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14565 real(kind=8),dimension(4) :: muij
14566 !el integer :: num_conti,j1,j2
14567 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14568 !el dz_normi,xmedi,ymedi,zmedi
14569 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14570 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14571 !el num_conti,j1,j2
14572 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14574 real(kind=8) :: scal_el=1.0d0
14576 real(kind=8) :: scal_el=0.5d0
14579 ! 13-go grudnia roku pamietnego...
14580 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14581 0.0d0,1.0d0,0.0d0,&
14582 0.0d0,0.0d0,1.0d0/),shape(unmat))
14583 !el local variables
14585 real(kind=8) :: fac
14586 real(kind=8) :: dxj,dyj,dzj
14587 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
14589 ! allocate(num_cont_hb(nres)) !(maxres)
14590 !d write(iout,*) 'In EELEC'
14592 !d write(iout,*) 'Type',i
14593 !d write(iout,*) 'B1',B1(:,i)
14594 !d write(iout,*) 'B2',B2(:,i)
14595 !d write(iout,*) 'CC',CC(:,:,i)
14596 !d write(iout,*) 'DD',DD(:,:,i)
14597 !d write(iout,*) 'EE',EE(:,:,i)
14599 !d call check_vecgrad
14601 if (icheckgrad.eq.1) then
14603 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
14605 dc_norm(k,i)=dc(k,i)*fac
14607 ! write (iout,*) 'i',i,' fac',fac
14610 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14611 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
14612 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
14613 ! call vec_and_deriv
14617 ! print *, "before set matrices"
14619 ! print *,"after set martices"
14621 time_mat=time_mat+MPI_Wtime()-time01
14625 !d write (iout,*) 'i=',i
14627 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
14630 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
14631 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
14644 !d print '(a)','Enter EELEC'
14645 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
14646 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14647 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14649 gel_loc_loc(i)=0.0d0
14654 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
14656 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
14658 do i=iturn3_start,iturn3_end
14659 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
14660 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
14664 dx_normi=dc_norm(1,i)
14665 dy_normi=dc_norm(2,i)
14666 dz_normi=dc_norm(3,i)
14667 xmedi=c(1,i)+0.5d0*dxi
14668 ymedi=c(2,i)+0.5d0*dyi
14669 zmedi=c(3,i)+0.5d0*dzi
14670 call to_box(xmedi,ymedi,zmedi)
14671 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
14673 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
14674 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
14675 num_cont_hb(i)=num_conti
14677 do i=iturn4_start,iturn4_end
14678 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
14679 .or. itype(i+3,1).eq.ntyp1 &
14680 .or. itype(i+4,1).eq.ntyp1) cycle
14684 dx_normi=dc_norm(1,i)
14685 dy_normi=dc_norm(2,i)
14686 dz_normi=dc_norm(3,i)
14687 xmedi=c(1,i)+0.5d0*dxi
14688 ymedi=c(2,i)+0.5d0*dyi
14689 zmedi=c(3,i)+0.5d0*dzi
14691 call to_box(xmedi,ymedi,zmedi)
14692 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
14694 num_conti=num_cont_hb(i)
14695 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
14696 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
14697 call eturn4(i,eello_turn4)
14698 num_cont_hb(i)=num_conti
14701 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
14703 do i=iatel_s,iatel_e
14704 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14708 dx_normi=dc_norm(1,i)
14709 dy_normi=dc_norm(2,i)
14710 dz_normi=dc_norm(3,i)
14711 xmedi=c(1,i)+0.5d0*dxi
14712 ymedi=c(2,i)+0.5d0*dyi
14713 zmedi=c(3,i)+0.5d0*dzi
14714 call to_box(xmedi,ymedi,zmedi)
14715 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
14716 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14717 num_conti=num_cont_hb(i)
14718 do j=ielstart(i),ielend(i)
14719 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14720 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14722 num_cont_hb(i)=num_conti
14724 ! write (iout,*) "Number of loop steps in EELEC:",ind
14726 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14727 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14729 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14730 !cc eel_loc=eel_loc+eello_turn3
14731 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14733 end subroutine eelec_scale
14734 !-----------------------------------------------------------------------------
14735 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14736 ! implicit real*8 (a-h,o-z)
14739 ! include 'DIMENSIONS'
14743 ! include 'COMMON.CONTROL'
14744 ! include 'COMMON.IOUNITS'
14745 ! include 'COMMON.GEO'
14746 ! include 'COMMON.VAR'
14747 ! include 'COMMON.LOCAL'
14748 ! include 'COMMON.CHAIN'
14749 ! include 'COMMON.DERIV'
14750 ! include 'COMMON.INTERACT'
14751 ! include 'COMMON.CONTACTS'
14752 ! include 'COMMON.TORSION'
14753 ! include 'COMMON.VECTORS'
14754 ! include 'COMMON.FFIELD'
14755 ! include 'COMMON.TIME1'
14756 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14757 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14758 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14759 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14760 real(kind=8),dimension(4) :: muij
14761 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14762 dist_temp, dist_init,sss_grad
14763 integer xshift,yshift,zshift
14765 !el integer :: num_conti,j1,j2
14766 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14767 !el dz_normi,xmedi,ymedi,zmedi
14768 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14769 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14770 !el num_conti,j1,j2
14771 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14773 real(kind=8) :: scal_el=1.0d0
14775 real(kind=8) :: scal_el=0.5d0
14778 ! 13-go grudnia roku pamietnego...
14779 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14780 0.0d0,1.0d0,0.0d0,&
14781 0.0d0,0.0d0,1.0d0/),shape(unmat))
14782 !el local variables
14783 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
14784 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
14785 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
14786 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
14787 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
14788 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
14789 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
14790 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
14791 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
14792 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
14793 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
14794 ecosam,ecosbm,ecosgm,ghalf,time00,faclipij,faclipij2
14795 ! integer :: maxconts
14796 ! maxconts = nres/4
14797 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14798 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14799 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14800 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14801 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14802 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14803 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14804 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14805 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
14806 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
14807 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
14808 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
14809 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
14811 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
14812 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
14817 !d write (iout,*) "eelecij",i,j
14821 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14822 aaa=app(iteli,itelj)
14823 bbb=bpp(iteli,itelj)
14824 ael6i=ael6(iteli,itelj)
14825 ael3i=ael3(iteli,itelj)
14829 dx_normj=dc_norm(1,j)
14830 dy_normj=dc_norm(2,j)
14831 dz_normj=dc_norm(3,j)
14832 ! xj=c(1,j)+0.5D0*dxj-xmedi
14833 ! yj=c(2,j)+0.5D0*dyj-ymedi
14834 ! zj=c(3,j)+0.5D0*dzj-zmedi
14835 xj=c(1,j)+0.5D0*dxj
14836 yj=c(2,j)+0.5D0*dyj
14837 zj=c(3,j)+0.5D0*dzj
14838 call to_box(xj,yj,zj)
14839 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
14840 faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
14841 faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
14842 xj=boxshift(xj-xmedi,boxxsize)
14843 yj=boxshift(yj-ymedi,boxysize)
14844 zj=boxshift(zj-zmedi,boxzsize)
14845 rij=xj*xj+yj*yj+zj*zj
14849 ! For extracting the short-range part of Evdwpp
14850 sss=sscale(rij/rpp(iteli,itelj))
14851 sss_ele_cut=sscale_ele(rij)
14852 sss_ele_grad=sscagrad_ele(rij)
14853 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14854 ! sss_ele_cut=1.0d0
14855 ! sss_ele_grad=0.0d0
14856 if (sss_ele_cut.le.0.0) go to 128
14860 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
14861 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
14862 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
14863 fac=cosa-3.0D0*cosb*cosg
14865 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14866 if (j.eq.i+2) ev1=scal_el*ev1
14871 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
14874 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
14875 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
14876 ees=ees+eesij*sss_ele_cut
14877 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
14878 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
14879 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
14880 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
14881 !d & xmedi,ymedi,zmedi,xj,yj,zj
14883 if (energy_dec) then
14884 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14885 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
14889 ! Calculate contributions to the Cartesian gradient.
14892 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14893 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14899 ! Radial derivatives. First process both termini of the fragment (i,j)
14901 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14902 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14903 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14905 ! ghalf=0.5D0*ggg(k)
14906 ! gelc(k,i)=gelc(k,i)+ghalf
14907 ! gelc(k,j)=gelc(k,j)+ghalf
14909 ! 9/28/08 AL Gradient compotents will be summed only at the end
14911 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14912 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14915 ! Loop over residues i+1 thru j-1.
14919 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14922 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14923 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14924 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14925 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14926 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14927 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14929 ! ghalf=0.5D0*ggg(k)
14930 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14931 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14933 ! 9/28/08 AL Gradient compotents will be summed only at the end
14935 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14936 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14939 ! Loop over residues i+1 thru j-1.
14943 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14947 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14948 facel=(el1+eesij)*sss_ele_cut
14950 fac=-3*rrmij*(facvdw+facvdw+facel)
14955 ! Radial derivatives. First process both termini of the fragment (i,j)
14961 ! ghalf=0.5D0*ggg(k)
14962 ! gelc(k,i)=gelc(k,i)+ghalf
14963 ! gelc(k,j)=gelc(k,j)+ghalf
14965 ! 9/28/08 AL Gradient compotents will be summed only at the end
14967 gelc_long(k,j)=gelc(k,j)+ggg(k)
14968 gelc_long(k,i)=gelc(k,i)-ggg(k)
14971 ! Loop over residues i+1 thru j-1.
14975 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14978 ! 9/28/08 AL Gradient compotents will be summed only at the end
14983 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14984 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14990 ecosa=2.0D0*fac3*fac1+fac4
14993 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14994 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14996 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14997 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14999 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
15000 !d & (dcosg(k),k=1,3)
15002 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
15005 ! ghalf=0.5D0*ggg(k)
15006 ! gelc(k,i)=gelc(k,i)+ghalf
15007 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
15008 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15009 ! gelc(k,j)=gelc(k,j)+ghalf
15010 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
15011 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15015 !grad gelc(l,k)=gelc(l,k)+ggg(l)
15019 gelc(k,i)=gelc(k,i) &
15020 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15021 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
15023 gelc(k,j)=gelc(k,j) &
15024 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15025 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
15027 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
15028 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
15030 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
15031 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
15032 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
15034 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
15035 ! energy of a peptide unit is assumed in the form of a second-order
15036 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
15037 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
15038 ! are computed for EVERY pair of non-contiguous peptide groups.
15040 if (j.lt.nres-1) then
15051 muij(kkk)=mu(k,i)*mu(l,j)
15054 !d write (iout,*) 'EELEC: i',i,' j',j
15055 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
15056 !d write(iout,*) 'muij',muij
15057 ury=scalar(uy(1,i),erij)
15058 urz=scalar(uz(1,i),erij)
15059 vry=scalar(uy(1,j),erij)
15060 vrz=scalar(uz(1,j),erij)
15061 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
15062 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
15063 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
15064 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
15065 fac=dsqrt(-ael6i)*r3ij
15070 !d write (iout,'(4i5,4f10.5)')
15071 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
15072 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
15073 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
15074 !d & uy(:,j),uz(:,j)
15075 !d write (iout,'(4f10.5)')
15076 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
15077 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
15078 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
15079 !d write (iout,'(9f10.5/)')
15080 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
15081 ! Derivatives of the elements of A in virtual-bond vectors
15082 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
15084 uryg(k,1)=scalar(erder(1,k),uy(1,i))
15085 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
15086 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
15087 urzg(k,1)=scalar(erder(1,k),uz(1,i))
15088 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
15089 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
15090 vryg(k,1)=scalar(erder(1,k),uy(1,j))
15091 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
15092 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
15093 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
15094 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
15095 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
15097 ! Compute radial contributions to the gradient
15115 ! Add the contributions coming from er
15118 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
15119 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
15120 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
15121 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
15124 ! Derivatives in DC(i)
15125 !grad ghalf1=0.5d0*agg(k,1)
15126 !grad ghalf2=0.5d0*agg(k,2)
15127 !grad ghalf3=0.5d0*agg(k,3)
15128 !grad ghalf4=0.5d0*agg(k,4)
15129 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
15130 -3.0d0*uryg(k,2)*vry)!+ghalf1
15131 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
15132 -3.0d0*uryg(k,2)*vrz)!+ghalf2
15133 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
15134 -3.0d0*urzg(k,2)*vry)!+ghalf3
15135 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
15136 -3.0d0*urzg(k,2)*vrz)!+ghalf4
15137 ! Derivatives in DC(i+1)
15138 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
15139 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
15140 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
15141 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
15142 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
15143 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
15144 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
15145 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
15146 ! Derivatives in DC(j)
15147 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
15148 -3.0d0*vryg(k,2)*ury)!+ghalf1
15149 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
15150 -3.0d0*vrzg(k,2)*ury)!+ghalf2
15151 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
15152 -3.0d0*vryg(k,2)*urz)!+ghalf3
15153 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
15154 -3.0d0*vrzg(k,2)*urz)!+ghalf4
15155 ! Derivatives in DC(j+1) or DC(nres-1)
15156 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
15157 -3.0d0*vryg(k,3)*ury)
15158 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
15159 -3.0d0*vrzg(k,3)*ury)
15160 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
15161 -3.0d0*vryg(k,3)*urz)
15162 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
15163 -3.0d0*vrzg(k,3)*urz)
15164 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
15166 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
15179 aggi(k,l)=-aggi(k,l)
15180 aggi1(k,l)=-aggi1(k,l)
15181 aggj(k,l)=-aggj(k,l)
15182 aggj1(k,l)=-aggj1(k,l)
15185 if (j.lt.nres-1) then
15191 aggi(k,l)=-aggi(k,l)
15192 aggi1(k,l)=-aggi1(k,l)
15193 aggj(k,l)=-aggj(k,l)
15194 aggj1(k,l)=-aggj1(k,l)
15205 aggi(k,l)=-aggi(k,l)
15206 aggi1(k,l)=-aggi1(k,l)
15207 aggj(k,l)=-aggj(k,l)
15208 aggj1(k,l)=-aggj1(k,l)
15213 IF (wel_loc.gt.0.0d0) THEN
15214 ! Contribution to the local-electrostatic energy coming from the i-j pair
15215 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
15217 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
15218 ! print *,"EELLOC",i,gel_loc_loc(i-1)
15219 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
15220 'eelloc',i,j,eel_loc_ij
15221 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
15223 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
15224 ! Partial derivatives in virtual-bond dihedral angles gamma
15226 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
15227 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
15228 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
15230 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
15231 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
15232 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
15238 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
15240 ggg(l)=(agg(l,1)*muij(1)+ &
15241 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
15243 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
15245 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
15246 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
15247 !grad ghalf=0.5d0*ggg(l)
15248 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
15249 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
15253 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
15256 ! Remaining derivatives of eello
15258 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
15259 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
15262 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
15263 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
15266 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
15267 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
15270 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
15271 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
15276 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
15277 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
15278 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
15279 .and. num_conti.le.maxconts) then
15280 ! write (iout,*) i,j," entered corr"
15282 ! Calculate the contact function. The ith column of the array JCONT will
15283 ! contain the numbers of atoms that make contacts with the atom I (of numbers
15284 ! greater than I). The arrays FACONT and GACONT will contain the values of
15285 ! the contact function and its derivative.
15286 ! r0ij=1.02D0*rpp(iteli,itelj)
15287 ! r0ij=1.11D0*rpp(iteli,itelj)
15288 r0ij=2.20D0*rpp(iteli,itelj)
15289 ! r0ij=1.55D0*rpp(iteli,itelj)
15290 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
15291 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
15292 if (fcont.gt.0.0D0) then
15293 num_conti=num_conti+1
15294 if (num_conti.gt.maxconts) then
15295 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
15296 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
15297 ' will skip next contacts for this conf.',num_conti
15299 jcont_hb(num_conti,i)=j
15300 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
15301 !d & " jcont_hb",jcont_hb(num_conti,i)
15302 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
15303 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
15304 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
15306 d_cont(num_conti,i)=rij
15307 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
15308 ! --- Electrostatic-interaction matrix ---
15309 a_chuj(1,1,num_conti,i)=a22
15310 a_chuj(1,2,num_conti,i)=a23
15311 a_chuj(2,1,num_conti,i)=a32
15312 a_chuj(2,2,num_conti,i)=a33
15313 ! --- Gradient of rij
15315 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
15322 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
15323 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
15324 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
15325 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
15326 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
15331 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
15332 ! Calculate contact energies
15334 wij=cosa-3.0D0*cosb*cosg
15337 ! fac3=dsqrt(-ael6i)/r0ij**3
15338 fac3=dsqrt(-ael6i)*r3ij
15339 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
15340 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
15341 if (ees0tmp.gt.0) then
15342 ees0pij=dsqrt(ees0tmp)
15346 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
15347 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
15348 if (ees0tmp.gt.0) then
15349 ees0mij=dsqrt(ees0tmp)
15354 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
15357 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
15360 ! Diagnostics. Comment out or remove after debugging!
15361 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
15362 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
15363 ! ees0m(num_conti,i)=0.0D0
15365 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
15366 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
15367 ! Angular derivatives of the contact function
15368 ees0pij1=fac3/ees0pij
15369 ees0mij1=fac3/ees0mij
15370 fac3p=-3.0D0*fac3*rrmij
15371 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
15372 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
15374 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
15375 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
15376 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
15377 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
15378 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
15379 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
15380 ecosap=ecosa1+ecosa2
15381 ecosbp=ecosb1+ecosb2
15382 ecosgp=ecosg1+ecosg2
15383 ecosam=ecosa1-ecosa2
15384 ecosbm=ecosb1-ecosb2
15385 ecosgm=ecosg1-ecosg2
15394 facont_hb(num_conti,i)=fcont
15395 fprimcont=fprimcont/rij
15396 !d facont_hb(num_conti,i)=1.0D0
15397 ! Following line is for diagnostics.
15400 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
15401 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
15404 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
15405 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
15407 ! gggp(1)=gggp(1)+ees0pijp*xj
15408 ! gggp(2)=gggp(2)+ees0pijp*yj
15409 ! gggp(3)=gggp(3)+ees0pijp*zj
15410 ! gggm(1)=gggm(1)+ees0mijp*xj
15411 ! gggm(2)=gggm(2)+ees0mijp*yj
15412 ! gggm(3)=gggm(3)+ees0mijp*zj
15413 gggp(1)=gggp(1)+ees0pijp*xj &
15414 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
15415 gggp(2)=gggp(2)+ees0pijp*yj &
15416 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
15417 gggp(3)=gggp(3)+ees0pijp*zj &
15418 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
15420 gggm(1)=gggm(1)+ees0mijp*xj &
15421 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
15423 gggm(2)=gggm(2)+ees0mijp*yj &
15424 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
15426 gggm(3)=gggm(3)+ees0mijp*zj &
15427 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
15429 ! Derivatives due to the contact function
15430 gacont_hbr(1,num_conti,i)=fprimcont*xj
15431 gacont_hbr(2,num_conti,i)=fprimcont*yj
15432 gacont_hbr(3,num_conti,i)=fprimcont*zj
15435 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
15436 ! following the change of gradient-summation algorithm.
15438 !grad ghalfp=0.5D0*gggp(k)
15439 !grad ghalfm=0.5D0*gggm(k)
15440 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
15441 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15442 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15443 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
15444 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15445 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15446 ! gacontp_hb3(k,num_conti,i)=gggp(k)
15447 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
15448 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15449 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15450 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
15451 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15452 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15453 ! gacontm_hb3(k,num_conti,i)=gggm(k)
15454 gacontp_hb1(k,num_conti,i)= & !ghalfp+
15455 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15456 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
15459 gacontp_hb2(k,num_conti,i)= & !ghalfp+
15460 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15461 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
15464 gacontp_hb3(k,num_conti,i)=gggp(k) &
15467 gacontm_hb1(k,num_conti,i)= & !ghalfm+
15468 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15469 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
15472 gacontm_hb2(k,num_conti,i)= & !ghalfm+
15473 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15474 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
15477 gacontm_hb3(k,num_conti,i)=gggm(k) &
15482 endif ! num_conti.le.maxconts
15485 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
15488 ghalf=0.5d0*agg(l,k)
15489 aggi(l,k)=aggi(l,k)+ghalf
15490 aggi1(l,k)=aggi1(l,k)+agg(l,k)
15491 aggj(l,k)=aggj(l,k)+ghalf
15494 if (j.eq.nres-1 .and. i.lt.j-2) then
15497 aggj1(l,k)=aggj1(l,k)+agg(l,k)
15503 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
15505 end subroutine eelecij_scale
15506 !-----------------------------------------------------------------------------
15507 subroutine evdwpp_short(evdw1)
15511 ! implicit real*8 (a-h,o-z)
15512 ! include 'DIMENSIONS'
15513 ! include 'COMMON.CONTROL'
15514 ! include 'COMMON.IOUNITS'
15515 ! include 'COMMON.GEO'
15516 ! include 'COMMON.VAR'
15517 ! include 'COMMON.LOCAL'
15518 ! include 'COMMON.CHAIN'
15519 ! include 'COMMON.DERIV'
15520 ! include 'COMMON.INTERACT'
15521 ! include 'COMMON.CONTACTS'
15522 ! include 'COMMON.TORSION'
15523 ! include 'COMMON.VECTORS'
15524 ! include 'COMMON.FFIELD'
15525 real(kind=8),dimension(3) :: ggg
15526 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
15528 real(kind=8) :: scal_el=1.0d0
15530 real(kind=8) :: scal_el=0.5d0
15532 !el local variables
15533 integer :: i,j,k,iteli,itelj,num_conti,isubchap
15534 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
15535 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
15536 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
15537 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
15538 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15539 dist_temp, dist_init,sss_grad,sslipi,ssgradlipi,&
15540 sslipj,ssgradlipj,faclipij2
15541 integer xshift,yshift,zshift
15545 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
15546 ! & " iatel_e_vdw",iatel_e_vdw
15548 do i=iatel_s_vdw,iatel_e_vdw
15549 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
15553 dx_normi=dc_norm(1,i)
15554 dy_normi=dc_norm(2,i)
15555 dz_normi=dc_norm(3,i)
15556 xmedi=c(1,i)+0.5d0*dxi
15557 ymedi=c(2,i)+0.5d0*dyi
15558 zmedi=c(3,i)+0.5d0*dzi
15559 call to_box(xmedi,ymedi,zmedi)
15560 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
15562 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
15563 ! & ' ielend',ielend_vdw(i)
15565 do j=ielstart_vdw(i),ielend_vdw(i)
15566 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
15570 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
15571 aaa=app(iteli,itelj)
15572 bbb=bpp(iteli,itelj)
15576 dx_normj=dc_norm(1,j)
15577 dy_normj=dc_norm(2,j)
15578 dz_normj=dc_norm(3,j)
15579 ! xj=c(1,j)+0.5D0*dxj-xmedi
15580 ! yj=c(2,j)+0.5D0*dyj-ymedi
15581 ! zj=c(3,j)+0.5D0*dzj-zmedi
15582 xj=c(1,j)+0.5D0*dxj
15583 yj=c(2,j)+0.5D0*dyj
15584 zj=c(3,j)+0.5D0*dzj
15585 call to_box(xj,yj,zj)
15586 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
15587 faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
15588 xj=boxshift(xj-xmedi,boxxsize)
15589 yj=boxshift(yj-ymedi,boxysize)
15590 zj=boxshift(zj-zmedi,boxzsize)
15591 rij=xj*xj+yj*yj+zj*zj
15594 sss=sscale(rij/rpp(iteli,itelj))
15595 sss_ele_cut=sscale_ele(rij)
15596 sss_ele_grad=sscagrad_ele(rij)
15597 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15598 if (sss_ele_cut.le.0.0) cycle
15599 if (sss.gt.0.0d0) then
15604 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15605 if (j.eq.i+2) ev1=scal_el*ev1
15608 if (energy_dec) then
15609 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15611 evdw1=evdw1+evdwij*sss*sss_ele_cut
15613 ! Calculate contributions to the Cartesian gradient.
15615 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
15619 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
15620 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15621 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
15622 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15623 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
15624 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15627 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15628 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15634 end subroutine evdwpp_short
15635 !-----------------------------------------------------------------------------
15636 subroutine escp_long(evdw2,evdw2_14)
15638 ! This subroutine calculates the excluded-volume interaction energy between
15639 ! peptide-group centers and side chains and its gradient in virtual-bond and
15640 ! side-chain vectors.
15642 ! implicit real*8 (a-h,o-z)
15643 ! include 'DIMENSIONS'
15644 ! include 'COMMON.GEO'
15645 ! include 'COMMON.VAR'
15646 ! include 'COMMON.LOCAL'
15647 ! include 'COMMON.CHAIN'
15648 ! include 'COMMON.DERIV'
15649 ! include 'COMMON.INTERACT'
15650 ! include 'COMMON.FFIELD'
15651 ! include 'COMMON.IOUNITS'
15652 ! include 'COMMON.CONTROL'
15653 real(kind=8),dimension(3) :: ggg
15654 !el local variables
15655 integer :: i,iint,j,k,iteli,itypj,subchap
15656 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15657 real(kind=8) :: evdw2,evdw2_14,evdwij
15658 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15659 dist_temp, dist_init
15663 !d print '(a)','Enter ESCP'
15664 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15665 do i=iatscp_s,iatscp_e
15666 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15668 xi=0.5D0*(c(1,i)+c(1,i+1))
15669 yi=0.5D0*(c(2,i)+c(2,i+1))
15670 zi=0.5D0*(c(3,i)+c(3,i+1))
15671 call to_box(xi,yi,zi)
15672 do iint=1,nscp_gr(i)
15674 do j=iscpstart(i,iint),iscpend(i,iint)
15676 if (itypj.eq.ntyp1) cycle
15677 ! Uncomment following three lines for SC-p interactions
15678 ! xj=c(1,nres+j)-xi
15679 ! yj=c(2,nres+j)-yi
15680 ! zj=c(3,nres+j)-zi
15681 ! Uncomment following three lines for Ca-p interactions
15685 call to_box(xj,yj,zj)
15686 xj=boxshift(xj-xi,boxxsize)
15687 yj=boxshift(yj-yi,boxysize)
15688 zj=boxshift(zj-zi,boxzsize)
15689 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15691 rij=dsqrt(1.0d0/rrij)
15692 sss_ele_cut=sscale_ele(rij)
15693 sss_ele_grad=sscagrad_ele(rij)
15694 ! print *,sss_ele_cut,sss_ele_grad,&
15695 ! (rij),r_cut_ele,rlamb_ele
15696 if (sss_ele_cut.le.0.0) cycle
15697 sss=sscale((rij/rscp(itypj,iteli)))
15698 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15699 if (sss.lt.1.0d0) then
15702 e1=fac*fac*aad(itypj,iteli)
15703 e2=fac*bad(itypj,iteli)
15704 if (iabs(j-i) .le. 2) then
15707 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
15710 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
15711 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15712 'evdw2',i,j,sss,evdwij
15714 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15716 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
15717 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
15718 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15722 ! Uncomment following three lines for SC-p interactions
15724 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15726 ! Uncomment following line for SC-p interactions
15727 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15729 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15730 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15739 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15740 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15741 gradx_scp(j,i)=expon*gradx_scp(j,i)
15744 !******************************************************************************
15748 ! To save time the factor EXPON has been extracted from ALL components
15749 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15752 !******************************************************************************
15754 end subroutine escp_long
15755 !-----------------------------------------------------------------------------
15756 subroutine escp_short(evdw2,evdw2_14)
15758 ! This subroutine calculates the excluded-volume interaction energy between
15759 ! peptide-group centers and side chains and its gradient in virtual-bond and
15760 ! side-chain vectors.
15762 ! implicit real*8 (a-h,o-z)
15763 ! include 'DIMENSIONS'
15764 ! include 'COMMON.GEO'
15765 ! include 'COMMON.VAR'
15766 ! include 'COMMON.LOCAL'
15767 ! include 'COMMON.CHAIN'
15768 ! include 'COMMON.DERIV'
15769 ! include 'COMMON.INTERACT'
15770 ! include 'COMMON.FFIELD'
15771 ! include 'COMMON.IOUNITS'
15772 ! include 'COMMON.CONTROL'
15773 real(kind=8),dimension(3) :: ggg
15774 !el local variables
15775 integer :: i,iint,j,k,iteli,itypj,subchap
15776 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15777 real(kind=8) :: evdw2,evdw2_14,evdwij
15778 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15779 dist_temp, dist_init
15783 !d print '(a)','Enter ESCP'
15784 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15785 do i=iatscp_s,iatscp_e
15786 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15788 xi=0.5D0*(c(1,i)+c(1,i+1))
15789 yi=0.5D0*(c(2,i)+c(2,i+1))
15790 zi=0.5D0*(c(3,i)+c(3,i+1))
15791 call to_box(xi,yi,zi)
15792 if (zi.lt.0) zi=zi+boxzsize
15794 do iint=1,nscp_gr(i)
15796 do j=iscpstart(i,iint),iscpend(i,iint)
15798 if (itypj.eq.ntyp1) cycle
15799 ! Uncomment following three lines for SC-p interactions
15800 ! xj=c(1,nres+j)-xi
15801 ! yj=c(2,nres+j)-yi
15802 ! zj=c(3,nres+j)-zi
15803 ! Uncomment following three lines for Ca-p interactions
15810 call to_box(xj,yj,zj)
15811 xj=boxshift(xj-xi,boxxsize)
15812 yj=boxshift(yj-yi,boxysize)
15813 zj=boxshift(zj-zi,boxzsize)
15814 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15815 rij=dsqrt(1.0d0/rrij)
15816 sss_ele_cut=sscale_ele(rij)
15817 sss_ele_grad=sscagrad_ele(rij)
15818 ! print *,sss_ele_cut,sss_ele_grad,&
15819 ! (rij),r_cut_ele,rlamb_ele
15820 if (sss_ele_cut.le.0.0) cycle
15821 sss=sscale(rij/rscp(itypj,iteli))
15822 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15823 if (sss.gt.0.0d0) then
15826 e1=fac*fac*aad(itypj,iteli)
15827 e2=fac*bad(itypj,iteli)
15828 if (iabs(j-i) .le. 2) then
15831 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15834 evdw2=evdw2+evdwij*sss*sss_ele_cut
15835 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15836 'evdw2',i,j,sss,evdwij
15838 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15840 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15841 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15842 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15847 ! Uncomment following three lines for SC-p interactions
15849 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15851 ! Uncomment following line for SC-p interactions
15852 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15854 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15855 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15864 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15865 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15866 gradx_scp(j,i)=expon*gradx_scp(j,i)
15869 !******************************************************************************
15873 ! To save time the factor EXPON has been extracted from ALL components
15874 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15877 !******************************************************************************
15879 end subroutine escp_short
15880 !-----------------------------------------------------------------------------
15881 ! energy_p_new-sep_barrier.F
15882 !-----------------------------------------------------------------------------
15883 subroutine sc_grad_scale(scalfac)
15884 ! implicit real*8 (a-h,o-z)
15886 ! include 'DIMENSIONS'
15887 ! include 'COMMON.CHAIN'
15888 ! include 'COMMON.DERIV'
15889 ! include 'COMMON.CALC'
15890 ! include 'COMMON.IOUNITS'
15891 real(kind=8),dimension(3) :: dcosom1,dcosom2
15892 real(kind=8) :: scalfac
15893 !el local variables
15894 ! integer :: i,j,k,l
15896 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15897 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15898 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15899 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15903 ! eom12=evdwij*eps1_om12
15905 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15906 ! & " sigder",sigder
15907 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15908 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15910 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15911 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15914 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15917 ! write (iout,*) "gg",(gg(k),k=1,3)
15919 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15920 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15921 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15923 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15924 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15925 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15927 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15928 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15929 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15930 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15933 ! Calculate the components of the gradient in DC and X
15936 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15937 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15940 end subroutine sc_grad_scale
15941 !-----------------------------------------------------------------------------
15942 ! energy_split-sep.F
15943 !-----------------------------------------------------------------------------
15944 subroutine etotal_long(energia)
15946 ! Compute the long-range slow-varying contributions to the energy
15948 ! implicit real*8 (a-h,o-z)
15949 ! include 'DIMENSIONS'
15950 use MD_data, only: totT,usampl,eq_time
15954 !MS$ATTRIBUTES C :: proc_proc
15959 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15961 ! include 'COMMON.SETUP'
15962 ! include 'COMMON.IOUNITS'
15963 ! include 'COMMON.FFIELD'
15964 ! include 'COMMON.DERIV'
15965 ! include 'COMMON.INTERACT'
15966 ! include 'COMMON.SBRIDGE'
15967 ! include 'COMMON.CHAIN'
15968 ! include 'COMMON.VAR'
15969 ! include 'COMMON.LOCAL'
15970 ! include 'COMMON.MD'
15971 real(kind=8),dimension(0:n_ene) :: energia
15972 !el local variables
15973 integer :: i,n_corr,n_corr1,ierror,ierr
15974 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15975 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15976 ecorr,ecorr5,ecorr6,eturn6,time00
15977 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15978 !elwrite(iout,*)"in etotal long"
15980 if (modecalc.eq.12.or.modecalc.eq.14) then
15982 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15984 call int_from_cart1(.false.)
15987 !elwrite(iout,*)"in etotal long"
15990 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15991 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15993 if (nfgtasks.gt.1) then
15995 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15996 if (fg_rank.eq.0) then
15997 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15998 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
16000 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
16001 ! FG slaves as WEIGHTS array.
16008 weights_(7)=wel_loc
16011 weights_(10)=wturn6
16013 weights_(12)=wscloc
16015 weights_(14)=wtor_d
16016 weights_(15)=wstrain
16017 weights_(16)=wvdwpp
16019 weights_(18)=scal14
16020 weights_(21)=wsccor
16021 ! FG Master broadcasts the WEIGHTS_ array
16022 call MPI_Bcast(weights_(1),n_ene,&
16023 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16025 ! FG slaves receive the WEIGHTS array
16026 call MPI_Bcast(weights(1),n_ene,&
16027 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16042 wstrain=weights(15)
16048 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
16050 time_Bcast=time_Bcast+MPI_Wtime()-time00
16051 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
16052 ! call chainbuild_cart
16053 ! call int_from_cart1(.false.)
16055 ! write (iout,*) 'Processor',myrank,
16056 ! & ' calling etotal_short ipot=',ipot
16058 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
16060 !d print *,'nnt=',nnt,' nct=',nct
16062 !elwrite(iout,*)"in etotal long"
16063 ! Compute the side-chain and electrostatic interaction energy
16065 goto (101,102,103,104,105,106) ipot
16066 ! Lennard-Jones potential.
16067 101 call elj_long(evdw)
16068 !d print '(a)','Exit ELJ'
16070 ! Lennard-Jones-Kihara potential (shifted).
16071 102 call eljk_long(evdw)
16073 ! Berne-Pechukas potential (dilated LJ, angular dependence).
16074 103 call ebp_long(evdw)
16076 ! Gay-Berne potential (shifted LJ, angular dependence).
16077 104 call egb_long(evdw)
16079 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
16080 105 call egbv_long(evdw)
16082 ! Soft-sphere potential
16083 106 call e_softsphere(evdw)
16085 ! Calculate electrostatic (H-bonding) energy of the main chain.
16089 if (ipot.lt.6) then
16091 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
16092 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
16093 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
16094 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
16096 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
16097 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
16098 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
16099 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
16101 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
16110 ! write (iout,*) "Soft-spheer ELEC potential"
16111 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
16115 ! Calculate excluded-volume interaction energy between peptide groups
16118 if (ipot.lt.6) then
16119 if(wscp.gt.0d0) then
16120 call escp_long(evdw2,evdw2_14)
16126 call escp_soft_sphere(evdw2,evdw2_14)
16129 ! 12/1/95 Multi-body terms
16133 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
16134 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
16135 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
16136 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
16137 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
16144 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
16145 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
16148 ! If performing constraint dynamics, call the constraint energy
16149 ! after the equilibration time
16150 if(usampl.and.totT.gt.eq_time) then
16165 energia(2)=evdw2-evdw2_14
16166 energia(18)=evdw2_14
16175 energia(3)=ees+evdw1
16182 energia(8)=eello_turn3
16183 energia(9)=eello_turn4
16185 energia(20)=Uconst+Uconst_back
16186 call sum_energy(energia,.true.)
16187 ! write (iout,*) "Exit ETOTAL_LONG"
16190 end subroutine etotal_long
16191 !-----------------------------------------------------------------------------
16192 subroutine etotal_short(energia)
16194 ! Compute the short-range fast-varying contributions to the energy
16196 ! implicit real*8 (a-h,o-z)
16197 ! include 'DIMENSIONS'
16201 !MS$ATTRIBUTES C :: proc_proc
16206 integer :: ierror,ierr
16207 real(kind=8),dimension(n_ene) :: weights_
16208 real(kind=8) :: time00
16210 ! include 'COMMON.SETUP'
16211 ! include 'COMMON.IOUNITS'
16212 ! include 'COMMON.FFIELD'
16213 ! include 'COMMON.DERIV'
16214 ! include 'COMMON.INTERACT'
16215 ! include 'COMMON.SBRIDGE'
16216 ! include 'COMMON.CHAIN'
16217 ! include 'COMMON.VAR'
16218 ! include 'COMMON.LOCAL'
16219 real(kind=8),dimension(0:n_ene) :: energia
16220 !el local variables
16222 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
16223 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
16226 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
16228 if (modecalc.eq.12.or.modecalc.eq.14) then
16230 if (fg_rank.eq.0) call int_from_cart1(.false.)
16232 call int_from_cart1(.false.)
16236 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
16237 ! & " absolute rank",myrank," nfgtasks",nfgtasks
16239 if (nfgtasks.gt.1) then
16241 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
16242 if (fg_rank.eq.0) then
16243 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
16244 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
16246 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
16247 ! FG slaves as WEIGHTS array.
16254 weights_(7)=wel_loc
16257 weights_(10)=wturn6
16259 weights_(12)=wscloc
16261 weights_(14)=wtor_d
16262 weights_(15)=wstrain
16263 weights_(16)=wvdwpp
16265 weights_(18)=scal14
16266 weights_(21)=wsccor
16267 ! FG Master broadcasts the WEIGHTS_ array
16268 call MPI_Bcast(weights_(1),n_ene,&
16269 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16271 ! FG slaves receive the WEIGHTS array
16272 call MPI_Bcast(weights(1),n_ene,&
16273 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16288 wstrain=weights(15)
16294 ! write (iout,*),"Processor",myrank," BROADCAST weights"
16295 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
16297 ! write (iout,*) "Processor",myrank," BROADCAST c"
16298 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
16300 ! write (iout,*) "Processor",myrank," BROADCAST dc"
16301 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
16303 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
16304 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
16306 ! write (iout,*) "Processor",myrank," BROADCAST theta"
16307 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
16309 ! write (iout,*) "Processor",myrank," BROADCAST phi"
16310 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
16312 ! write (iout,*) "Processor",myrank," BROADCAST alph"
16313 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
16315 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
16316 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
16318 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
16319 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
16321 time_Bcast=time_Bcast+MPI_Wtime()-time00
16322 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
16324 ! write (iout,*) 'Processor',myrank,
16325 ! & ' calling etotal_short ipot=',ipot
16327 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
16329 ! call int_from_cart1(.false.)
16331 ! Compute the side-chain and electrostatic interaction energy
16333 goto (101,102,103,104,105,106) ipot
16334 ! Lennard-Jones potential.
16335 101 call elj_short(evdw)
16336 !d print '(a)','Exit ELJ'
16338 ! Lennard-Jones-Kihara potential (shifted).
16339 102 call eljk_short(evdw)
16341 ! Berne-Pechukas potential (dilated LJ, angular dependence).
16342 103 call ebp_short(evdw)
16344 ! Gay-Berne potential (shifted LJ, angular dependence).
16345 104 call egb_short(evdw)
16347 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
16348 105 call egbv_short(evdw)
16350 ! Soft-sphere potential - already dealt with in the long-range part
16352 ! 106 call e_softsphere_short(evdw)
16354 ! Calculate electrostatic (H-bonding) energy of the main chain.
16358 ! Calculate the short-range part of Evdwpp
16360 call evdwpp_short(evdw1)
16362 ! Calculate the short-range part of ESCp
16364 if (ipot.lt.6) then
16365 call escp_short(evdw2,evdw2_14)
16368 ! Calculate the bond-stretching energy
16372 ! Calculate the disulfide-bridge and other energy and the contributions
16373 ! from other distance constraints.
16376 ! Calculate the virtual-bond-angle energy.
16378 ! Calculate the SC local energy.
16383 if (wang.gt.0d0) then
16384 if (tor_mode.eq.0) then
16387 !C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
16389 call ebend_kcc(ebe)
16395 if (with_theta_constr) call etheta_constr(ethetacnstr)
16397 ! write(iout,*) "in etotal afer ebe",ipot
16399 ! print *,"Processor",myrank," computed UB"
16401 ! Calculate the SC local energy.
16404 !elwrite(iout,*) "in etotal afer esc",ipot
16405 ! print *,"Processor",myrank," computed USC"
16407 ! Calculate the virtual-bond torsional energy.
16409 !d print *,'nterm=',nterm
16410 ! if (wtor.gt.0) then
16411 ! call etor(etors,edihcnstr)
16416 if (wtor.gt.0.0d0) then
16417 if (tor_mode.eq.0) then
16420 !C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
16422 call etor_kcc(etors)
16428 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
16430 ! Calculate the virtual-bond torsional energy.
16433 ! 6/23/01 Calculate double-torsional energy
16435 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
16436 call etor_d(etors_d)
16439 ! 21/5/07 Calculate local sicdechain correlation energy
16441 if (wsccor.gt.0.0d0) then
16442 call eback_sc_corr(esccor)
16447 ! Put energy components into an array
16454 energia(2)=evdw2-evdw2_14
16455 energia(18)=evdw2_14
16468 energia(14)=etors_d
16471 energia(19)=edihcnstr
16473 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
16475 call sum_energy(energia,.true.)
16476 ! write (iout,*) "Exit ETOTAL_SHORT"
16479 end subroutine etotal_short
16480 !-----------------------------------------------------------------------------
16482 !-----------------------------------------------------------------------------
16483 real(kind=8) function gnmr1(y,ymin,ymax)
16485 real(kind=8) :: y,ymin,ymax
16486 real(kind=8) :: wykl=4.0d0
16487 if (y.lt.ymin) then
16488 gnmr1=(ymin-y)**wykl/wykl
16489 else if (y.gt.ymax) then
16490 gnmr1=(y-ymax)**wykl/wykl
16496 !-----------------------------------------------------------------------------
16497 real(kind=8) function gnmr1prim(y,ymin,ymax)
16499 real(kind=8) :: y,ymin,ymax
16500 real(kind=8) :: wykl=4.0d0
16501 if (y.lt.ymin) then
16502 gnmr1prim=-(ymin-y)**(wykl-1)
16503 else if (y.gt.ymax) then
16504 gnmr1prim=(y-ymax)**(wykl-1)
16509 end function gnmr1prim
16510 !----------------------------------------------------------------------------
16511 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
16512 real(kind=8) y,ymin,ymax,sigma
16513 real(kind=8) wykl /4.0d0/
16514 if (y.lt.ymin) then
16515 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
16516 else if (y.gt.ymax) then
16517 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
16522 end function rlornmr1
16523 !------------------------------------------------------------------------------
16524 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
16525 real(kind=8) y,ymin,ymax,sigma
16526 real(kind=8) wykl /4.0d0/
16527 if (y.lt.ymin) then
16528 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
16529 ((ymin-y)**wykl+sigma**wykl)**2
16530 else if (y.gt.ymax) then
16531 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
16532 ((y-ymax)**wykl+sigma**wykl)**2
16537 end function rlornmr1prim
16539 real(kind=8) function harmonic(y,ymax)
16541 real(kind=8) :: y,ymax
16542 real(kind=8) :: wykl=2.0d0
16543 harmonic=(y-ymax)**wykl
16545 end function harmonic
16546 !-----------------------------------------------------------------------------
16547 real(kind=8) function harmonicprim(y,ymax)
16548 real(kind=8) :: y,ymin,ymax
16549 real(kind=8) :: wykl=2.0d0
16550 harmonicprim=(y-ymax)*wykl
16552 end function harmonicprim
16553 !-----------------------------------------------------------------------------
16555 !-----------------------------------------------------------------------------
16556 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
16558 use io_base, only:intout,briefout
16559 ! implicit real*8 (a-h,o-z)
16560 ! include 'DIMENSIONS'
16561 ! include 'COMMON.CHAIN'
16562 ! include 'COMMON.DERIV'
16563 ! include 'COMMON.VAR'
16564 ! include 'COMMON.INTERACT'
16565 ! include 'COMMON.FFIELD'
16566 ! include 'COMMON.MD'
16567 ! include 'COMMON.IOUNITS'
16568 real(kind=8),external :: ufparm
16569 integer :: uiparm(1)
16570 real(kind=8) :: urparm(1)
16571 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
16572 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
16573 integer :: n,nf,ind,ind1,i,k,j
16575 ! This subroutine calculates total internal coordinate gradient.
16576 ! Depending on the number of function evaluations, either whole energy
16577 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
16578 ! internal coordinates are reevaluated or only the cartesian-in-internal
16579 ! coordinate derivatives are evaluated. The subroutine was designed to work
16585 !d print *,'grad',nf,icg
16586 if (nf-nfl+1) 20,30,40
16587 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
16588 ! write (iout,*) 'grad 20'
16589 if (nf.eq.0) return
16591 30 call var_to_geom(n,x)
16593 ! write (iout,*) 'grad 30'
16595 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
16598 ! write (iout,*) 'grad 40'
16599 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
16601 ! Convert the Cartesian gradient into internal-coordinate gradient.
16611 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16613 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
16616 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
16622 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
16624 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
16625 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
16628 if (i.gt.1) g(i-1)=gphii
16629 if (n.gt.nphi) g(nphi+i)=gthetai
16631 if (n.le.nphi+ntheta) goto 10
16633 if (itype(i,1).ne.10) then
16637 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
16640 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
16642 g(ialph(i,1))=galphai
16643 g(ialph(i,1)+nside)=gomegai
16647 ! Add the components corresponding to local energy terms.
16651 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
16652 g(i)=g(i)+gloc(i,icg)
16654 ! Uncomment following three lines for diagnostics.
16656 !elwrite(iout,*) "in gradient after calling intout"
16657 !d call briefout(0,0.0d0)
16658 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
16660 end subroutine gradient
16661 !-----------------------------------------------------------------------------
16662 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
16665 ! implicit real*8 (a-h,o-z)
16666 ! include 'DIMENSIONS'
16667 ! include 'COMMON.DERIV'
16668 ! include 'COMMON.IOUNITS'
16669 ! include 'COMMON.GEO'
16672 !el common /chuju/ jjj
16673 real(kind=8) :: energia(0:n_ene)
16674 integer :: uiparm(1)
16675 real(kind=8) :: urparm(1)
16677 real(kind=8),external :: ufparm
16678 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
16679 ! if (jjj.gt.0) then
16680 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16684 !d print *,'func',nf,nfl,icg
16685 call var_to_geom(n,x)
16688 !d write (iout,*) 'ETOTAL called from FUNC'
16689 call etotal(energia)
16692 ! if (jjj.gt.0) then
16693 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16694 ! write (iout,*) 'f=',etot
16698 end subroutine func
16699 !-----------------------------------------------------------------------------
16700 subroutine cartgrad
16701 ! implicit real*8 (a-h,o-z)
16702 ! include 'DIMENSIONS'
16704 use MD_data, only: totT,usampl,eq_time
16708 ! include 'COMMON.CHAIN'
16709 ! include 'COMMON.DERIV'
16710 ! include 'COMMON.VAR'
16711 ! include 'COMMON.INTERACT'
16712 ! include 'COMMON.FFIELD'
16713 ! include 'COMMON.MD'
16714 ! include 'COMMON.IOUNITS'
16715 ! include 'COMMON.TIME1'
16718 real(kind=8) :: time00,time01
16720 ! This subrouting calculates total Cartesian coordinate gradient.
16721 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
16724 #ifdef TIMINGtime01
16732 !el write (iout,*) "After sum_gradient"
16734 ! write (iout,*) "After sum_gradient"
16736 ! write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
16737 ! write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
16741 ! If performing constraint dynamics, add the gradients of the constraint energy
16742 if(usampl.and.totT.gt.eq_time) then
16745 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
16746 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
16750 gloc(i,icg)=gloc(i,icg)+dugamma(i)
16753 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
16756 !elwrite (iout,*) "After sum_gradient"
16761 !elwrite (iout,*) "After sum_gradient"
16763 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
16765 ! call checkintcartgrad
16766 ! write(iout,*) 'calling int_to_cart'
16769 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
16773 gcart(j,i)=gradc(j,i,icg)
16774 gxcart(j,i)=gradx(j,i,icg)
16775 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
16778 write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),&
16779 (gxcart(j,i),j=1,3),gloc(i,icg),(gloc_sc(j,i,icg),j=1,3)
16785 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16787 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16790 time_inttocart=time_inttocart+MPI_Wtime()-time01
16793 write (iout,*) "gcart and gxcart after int_to_cart"
16795 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
16796 (gxcart(j,i),j=1,3)
16802 write (iout,*) "CARGRAD"
16806 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16807 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16809 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
16810 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
16812 ! Correction: dummy residues
16815 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
16816 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
16819 if (nct.lt.nres) then
16821 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
16822 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
16827 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
16831 end subroutine cartgrad
16832 !-----------------------------------------------------------------------------
16833 subroutine zerograd
16834 ! implicit real*8 (a-h,o-z)
16835 ! include 'DIMENSIONS'
16836 ! include 'COMMON.DERIV'
16837 ! include 'COMMON.CHAIN'
16838 ! include 'COMMON.VAR'
16839 ! include 'COMMON.MD'
16840 ! include 'COMMON.SCCOR'
16842 !el local variables
16843 integer :: i,j,intertyp,k
16844 ! Initialize Cartesian-coordinate gradient
16846 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16847 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16849 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16850 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16851 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16852 ! allocate(gradcorr_long(3,nres))
16853 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16854 ! allocate(gcorr6_turn_long(3,nres))
16855 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16857 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16859 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16860 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16862 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16863 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16865 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16866 ! allocate(gscloc(3,nres)) !(3,maxres)
16867 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16871 ! common /deriv_scloc/
16872 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16873 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16874 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16876 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16880 ! gradc(j,i,icg)=0.0d0
16881 ! gradx(j,i,icg)=0.0d0
16883 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16884 !elwrite(iout,*) "icg",icg
16888 gradx_scp(j,i)=0.0D0
16890 gvdwc_scp(j,i)=0.0D0
16891 gvdwc_scpp(j,i)=0.0d0
16893 gelc_long(j,i)=0.0D0
16898 gel_loc_long(j,i)=0.0d0
16901 gcorr3_turn(j,i)=0.0d0
16902 gcorr4_turn(j,i)=0.0d0
16903 gradcorr(j,i)=0.0d0
16904 gradcorr_long(j,i)=0.0d0
16905 gradcorr5_long(j,i)=0.0d0
16906 gradcorr6_long(j,i)=0.0d0
16907 gcorr6_turn_long(j,i)=0.0d0
16908 gradcorr5(j,i)=0.0d0
16909 gradcorr6(j,i)=0.0d0
16910 gcorr6_turn(j,i)=0.0d0
16913 gradc(j,i,icg)=0.0d0
16914 gradx(j,i,icg)=0.0d0
16917 gliptran(j,i)=0.0d0
16918 gliptranx(j,i)=0.0d0
16919 gliptranc(j,i)=0.0d0
16920 gshieldx(j,i)=0.0d0
16921 gshieldc(j,i)=0.0d0
16922 gshieldc_loc(j,i)=0.0d0
16923 gshieldx_ec(j,i)=0.0d0
16924 gshieldc_ec(j,i)=0.0d0
16925 gshieldc_loc_ec(j,i)=0.0d0
16926 gshieldx_t3(j,i)=0.0d0
16927 gshieldc_t3(j,i)=0.0d0
16928 gshieldc_loc_t3(j,i)=0.0d0
16929 gshieldx_t4(j,i)=0.0d0
16930 gshieldc_t4(j,i)=0.0d0
16931 gshieldc_loc_t4(j,i)=0.0d0
16932 gshieldx_ll(j,i)=0.0d0
16933 gshieldc_ll(j,i)=0.0d0
16934 gshieldc_loc_ll(j,i)=0.0d0
16936 gg_tube_sc(j,i)=0.0d0
16938 gradb_nucl(j,i)=0.0d0
16939 gradbx_nucl(j,i)=0.0d0
16940 gvdwpp_nucl(j,i)=0.0d0
16944 gvdwpsb1(j,i)=0.0d0
16948 gradcorr_nucl(j,i)=0.0d0
16949 gradcorr3_nucl(j,i)=0.0d0
16950 gradxorr_nucl(j,i)=0.0d0
16951 gradxorr3_nucl(j,i)=0.0d0
16955 gradpepcat(j,i)=0.0d0
16956 gradpepcatx(j,i)=0.0d0
16957 gradcatcat(j,i)=0.0d0
16958 gvdwx_scbase(j,i)=0.0d0
16959 gvdwc_scbase(j,i)=0.0d0
16960 gvdwx_pepbase(j,i)=0.0d0
16961 gvdwc_pepbase(j,i)=0.0d0
16962 gvdwx_scpho(j,i)=0.0d0
16963 gvdwc_scpho(j,i)=0.0d0
16964 gvdwc_peppho(j,i)=0.0d0
16965 gradnuclcatx(j,i)=0.0d0
16966 gradnuclcat(j,i)=0.0d0
16972 gloc_sc(intertyp,i,icg)=0.0d0
16981 grad_shield_side(k,j,i)=0.0d0
16982 grad_shield_loc(k,j,i)=0.0d0
16989 ! Initialize the gradient of local energy terms.
16991 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16992 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16993 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16994 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16995 ! allocate(gel_loc_turn3(nres))
16996 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16997 ! allocate(gsccor_loc(nres)) !(maxres)
17003 gel_loc_loc(i)=0.0d0
17005 g_corr5_loc(i)=0.0d0
17006 g_corr6_loc(i)=0.0d0
17007 gel_loc_turn3(i)=0.0d0
17008 gel_loc_turn4(i)=0.0d0
17009 gel_loc_turn6(i)=0.0d0
17010 gsccor_loc(i)=0.0d0
17012 ! initialize gcart and gxcart
17013 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
17021 end subroutine zerograd
17022 !-----------------------------------------------------------------------------
17023 real(kind=8) function fdum()
17027 !-----------------------------------------------------------------------------
17029 !-----------------------------------------------------------------------------
17030 subroutine intcartderiv
17031 ! implicit real*8 (a-h,o-z)
17032 ! include 'DIMENSIONS'
17036 ! include 'COMMON.SETUP'
17037 ! include 'COMMON.CHAIN'
17038 ! include 'COMMON.VAR'
17039 ! include 'COMMON.GEO'
17040 ! include 'COMMON.INTERACT'
17041 ! include 'COMMON.DERIV'
17042 ! include 'COMMON.IOUNITS'
17043 ! include 'COMMON.LOCAL'
17044 ! include 'COMMON.SCCOR'
17045 real(kind=8) :: pi4,pi34
17046 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
17047 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
17048 dcosomega,dsinomega !(3,3,maxres)
17049 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
17052 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
17053 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
17054 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
17055 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14,IERROR
17059 !el from module energy-------------
17060 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
17061 !el allocate(dsintau(3,3,3,itau_start:itau_end))
17062 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
17064 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
17065 !el allocate(dsintau(3,3,3,0:nres2))
17066 !el allocate(dtauangle(3,3,3,0:nres2))
17067 !el allocate(domicron(3,2,2,0:nres2))
17068 !el allocate(dcosomicron(3,2,2,0:nres2))
17072 #if defined(MPI) && defined(PARINTDER)
17073 if (nfgtasks.gt.1 .and. me.eq.king) &
17074 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
17079 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
17080 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
17082 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
17085 dtheta(j,1,i)=0.0d0
17086 dtheta(j,2,i)=0.0d0
17090 dcosomicron(j,1,1,i)=0.0d0
17091 dcosomicron(j,1,2,i)=0.0d0
17092 dcosomicron(j,2,1,i)=0.0d0
17093 dcosomicron(j,2,2,i)=0.0d0
17096 ! Derivatives of theta's
17097 #if defined(MPI) && defined(PARINTDER)
17098 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
17099 do i=max0(ithet_start-1,3),ithet_end
17103 cost=dcos(theta(i))
17104 sint=sqrt(1-cost*cost)
17106 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
17108 if (((itype(i-1,1).ne.ntyp1).and.(sint.ne.0.0d0))) &
17109 dtheta(j,1,i)=-dcostheta(j,1,i)/sint
17110 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
17112 if ((itype(i-1,1).ne.ntyp1).and.(sint.ne.0.0d0))&
17113 dtheta(j,2,i)=-dcostheta(j,2,i)/sint
17116 #if defined(MPI) && defined(PARINTDER)
17117 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
17118 do i=max0(ithet_start-1,3),ithet_end
17122 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1).and.molnum(i).ne.5) then
17123 cost1=dcos(omicron(1,i))
17124 sint1=sqrt(1-cost1*cost1)
17125 cost2=dcos(omicron(2,i))
17126 sint2=sqrt(1-cost2*cost2)
17128 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
17129 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
17130 cost1*dc_norm(j,i-2))/ &
17132 domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
17133 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
17134 +cost1*(dc_norm(j,i-1+nres)))/ &
17136 domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
17137 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
17138 !C Looks messy but better than if in loop
17139 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
17140 +cost2*dc_norm(j,i-1))/ &
17142 domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
17143 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
17144 +cost2*(-dc_norm(j,i-1+nres)))/ &
17146 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
17147 domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
17151 !elwrite(iout,*) "after vbld write"
17152 ! Derivatives of phi:
17153 ! If phi is 0 or 180 degrees, then the formulas
17154 ! have to be derived by power series expansion of the
17155 ! conventional formulas around 0 and 180.
17157 do i=iphi1_start,iphi1_end
17161 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
17162 ! the conventional case
17163 sint=dsin(theta(i))
17164 sint1=dsin(theta(i-1))
17166 cost=dcos(theta(i))
17167 cost1=dcos(theta(i-1))
17169 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
17170 if ((sint*sint1).eq.0.0d0) then
17173 fac0=1.0d0/(sint1*sint)
17177 if (sint1.ne.0.0d0) then
17178 fac3=cosg*cost1/(sint1*sint1)
17182 if (sint.ne.0.0d0) then
17183 fac4=cosg*cost/(sint*sint)
17187 ! Obtaining the gamma derivatives from sine derivative
17188 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
17189 phi(i).gt.pi34.and.phi(i).le.pi.or. &
17190 phi(i).ge.-pi.and.phi(i).le.-pi34) then
17191 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
17192 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
17193 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
17195 if (sint.ne.0.0d0) then
17200 if (sint1.ne.0.0d0) then
17205 cosg_inv=1.0d0/cosg
17206 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
17207 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
17208 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
17209 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
17211 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
17212 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17213 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
17214 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
17215 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
17216 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17217 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
17219 ! write(iout,*) "just after,close to pi",dphi(j,3,i),&
17220 ! sing*(ctgt1*dtheta(j,2,i-1)),ctgt*dtheta(j,1,i), &
17221 ! (fac0*vp2(j)+sing*dc_norm(j,i-2)),vbld_inv(i-1)
17223 ! Bug fixed 3/24/05 (AL)
17225 ! Obtaining the gamma derivatives from cosine derivative
17228 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
17229 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
17230 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
17231 dc_norm(j,i-3))/vbld(i-2)
17232 dphi(j,1,i)=-1.0/sing*dcosphi(j,1,i)
17233 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
17234 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
17236 dphi(j,2,i)=-1.0/sing*dcosphi(j,2,i)
17237 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
17238 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
17239 dc_norm(j,i-1))/vbld(i)
17240 dphi(j,3,i)=-1.0/sing*dcosphi(j,3,i)
17243 write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
17250 !alculate derivative of Tauangle
17252 do i=itau_start,itau_end
17255 !elwrite(iout,*) " vecpr",i,nres
17257 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
17258 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
17259 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
17260 !c dtauangle(j,intertyp,dervityp,residue number)
17261 !c INTERTYP=1 SC...Ca...Ca..Ca
17262 ! the conventional case
17263 sint=dsin(theta(i))
17264 sint1=dsin(omicron(2,i-1))
17265 sing=dsin(tauangle(1,i))
17266 cost=dcos(theta(i))
17267 cost1=dcos(omicron(2,i-1))
17268 cosg=dcos(tauangle(1,i))
17269 !elwrite(iout,*) " vecpr5",i,nres
17271 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
17272 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
17273 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
17274 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
17276 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
17277 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac
17278 if ((sint*sint1).eq.0.0d0) then
17281 fac0=1.0d0/(sint1*sint)
17285 if (sint1.ne.0.0d0) then
17286 fac3=cosg*cost1/(sint1*sint1)
17290 if (sint.ne.0.0d0) then
17291 fac4=cosg*cost/(sint*sint)
17296 ! Obtaining the gamma derivatives from sine derivative
17297 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
17298 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
17299 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
17300 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
17301 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
17302 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
17306 cosg_inv=1.0d0/cosg
17307 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
17308 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
17309 *vbld_inv(i-2+nres)
17310 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
17311 dsintau(j,1,2,i)= &
17312 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
17313 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17314 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
17315 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
17316 ! Bug fixed 3/24/05 (AL)
17317 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
17318 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
17319 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17320 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
17322 ! Obtaining the gamma derivatives from cosine derivative
17325 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
17326 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
17327 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
17328 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
17329 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
17330 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
17332 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
17333 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
17334 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
17335 dc_norm(j,i-1))/vbld(i)
17336 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
17337 ! write (iout,*) "else",i
17341 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
17344 !C Second case Ca...Ca...Ca...SC
17346 do i=itau_start,itau_end
17350 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
17351 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
17352 ! the conventional case
17353 sint=dsin(omicron(1,i))
17354 sint1=dsin(theta(i-1))
17355 sing=dsin(tauangle(2,i))
17356 cost=dcos(omicron(1,i))
17357 cost1=dcos(theta(i-1))
17358 cosg=dcos(tauangle(2,i))
17360 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
17362 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
17363 if ((sint*sint1).eq.0.0d0) then
17366 fac0=1.0d0/(sint1*sint)
17370 if (sint1.ne.0.0d0) then
17371 fac3=cosg*cost1/(sint1*sint1)
17375 if (sint.ne.0.0d0) then
17376 fac4=cosg*cost/(sint*sint)
17380 ! Obtaining the gamma derivatives from sine derivative
17381 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
17382 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
17383 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
17384 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
17385 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
17386 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
17390 cosg_inv=1.0d0/cosg
17391 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
17392 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
17393 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
17394 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
17395 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
17396 dsintau(j,2,2,i)= &
17397 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
17398 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17399 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
17400 ! & sing*ctgt*domicron(j,1,2,i),
17401 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17402 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
17403 ! Bug fixed 3/24/05 (AL)
17404 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
17405 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
17406 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17407 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
17409 ! Obtaining the gamma derivatives from cosine derivative
17412 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
17413 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
17414 dc_norm(j,i-3))/vbld(i-2)
17415 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
17416 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
17417 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
17418 dcosomicron(j,1,1,i)
17419 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
17420 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
17421 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
17422 dc_norm(j,i-1+nres))/vbld(i-1+nres)
17423 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
17424 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
17429 !CC third case SC...Ca...Ca...SC
17432 do i=itau_start,itau_end
17436 ! the conventional case
17437 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
17438 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
17439 sint=dsin(omicron(1,i))
17440 sint1=dsin(omicron(2,i-1))
17441 sing=dsin(tauangle(3,i))
17442 cost=dcos(omicron(1,i))
17443 cost1=dcos(omicron(2,i-1))
17444 cosg=dcos(tauangle(3,i))
17446 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
17447 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
17449 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
17450 if ((sint*sint1).eq.0.0d0) then
17453 fac0=1.0d0/(sint1*sint)
17457 if (sint1.ne.0.0d0) then
17458 fac3=cosg*cost1/(sint1*sint1)
17462 if (sint.ne.0.0d0) then
17463 fac4=cosg*cost/(sint*sint)
17467 ! Obtaining the gamma derivatives from sine derivative
17468 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
17469 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
17470 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
17471 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
17472 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
17473 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
17477 cosg_inv=1.0d0/cosg
17478 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
17479 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
17480 *vbld_inv(i-2+nres)
17481 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
17482 dsintau(j,3,2,i)= &
17483 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
17484 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17485 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
17486 ! Bug fixed 3/24/05 (AL)
17487 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
17488 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
17489 *vbld_inv(i-1+nres)
17490 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17491 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
17493 ! Obtaining the gamma derivatives from cosine derivative
17496 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
17497 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
17498 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
17499 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
17500 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
17501 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
17502 dcosomicron(j,1,1,i)
17503 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
17504 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
17505 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
17506 dc_norm(j,i-1+nres))/vbld(i-1+nres)
17507 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
17508 ! write(iout,*) "else",i
17514 ! Derivatives of side-chain angles alpha and omega
17515 #if defined(MPI) && defined(PARINTDER)
17516 do i=ibond_start,ibond_end
17520 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
17521 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
17524 fac8=fac5/vbld(i+1)
17525 fac9=fac5/vbld(i+nres)
17526 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
17527 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
17528 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
17529 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
17530 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
17531 sina=sqrt(1-cosa*cosa)
17533 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
17535 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
17536 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
17537 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
17538 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
17539 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
17540 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
17541 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
17542 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
17544 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
17546 ! obtaining the derivatives of omega from sines
17547 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
17548 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
17549 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
17550 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
17552 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
17553 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
17554 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
17555 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
17556 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
17557 coso_inv=1.0d0/dcos(omeg(i))
17559 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
17560 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
17561 (sino*dc_norm(j,i-1))/vbld(i)
17562 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
17563 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
17564 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
17565 -sino*dc_norm(j,i)/vbld(i+1)
17566 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
17567 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
17568 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
17570 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
17573 ! obtaining the derivatives of omega from cosines
17574 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
17575 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
17580 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
17581 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
17582 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
17583 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
17584 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
17585 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
17586 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
17587 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
17588 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
17589 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
17590 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
17591 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
17592 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
17593 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
17594 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
17600 dalpha(k,j,i)=0.0d0
17601 domega(k,j,i)=0.0d0
17607 #if defined(MPI) && defined(PARINTDER)
17608 if (nfgtasks.gt.1) then
17610 !d write (iout,*) "Gather dtheta"
17611 !d call flush(iout)
17612 write (iout,*) "dtheta before gather"
17614 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
17617 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
17618 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
17619 king,FG_COMM,IERROR)
17622 !d write (iout,*) "Gather dphi"
17623 !d call flush(iout)
17624 write (iout,*) "dphi before gather"
17626 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
17630 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
17631 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
17632 king,FG_COMM,IERROR)
17633 !d write (iout,*) "Gather dalpha"
17634 !d call flush(iout)
17636 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
17637 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17638 king,FG_COMM,IERROR)
17639 !d write (iout,*) "Gather domega"
17640 !d call flush(iout)
17641 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
17642 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17643 king,FG_COMM,IERROR)
17649 write (iout,*) "dtheta after gather"
17651 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
17653 write (iout,*) "dphi after gather"
17655 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
17657 write (iout,*) "dalpha after gather"
17659 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
17661 write (iout,*) "domega after gather"
17663 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
17668 end subroutine intcartderiv
17669 !-----------------------------------------------------------------------------
17670 subroutine checkintcartgrad
17671 ! implicit real*8 (a-h,o-z)
17672 ! include 'DIMENSIONS'
17676 ! include 'COMMON.CHAIN'
17677 ! include 'COMMON.VAR'
17678 ! include 'COMMON.GEO'
17679 ! include 'COMMON.INTERACT'
17680 ! include 'COMMON.DERIV'
17681 ! include 'COMMON.IOUNITS'
17682 ! include 'COMMON.SETUP'
17683 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
17684 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
17685 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
17686 real(kind=8),dimension(3) :: dc_norm_s
17687 real(kind=8) :: aincr=1.0d-5
17689 real(kind=8) :: dcji
17692 theta_s(i)=theta(i)
17696 ! Check theta gradient
17698 "Analytical (upper) and numerical (lower) gradient of theta"
17703 dc(j,i-2)=dcji+aincr
17704 call chainbuild_cart
17705 call int_from_cart1(.false.)
17706 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
17709 dc(j,i-1)=dc(j,i-1)+aincr
17710 call chainbuild_cart
17711 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
17714 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
17715 !el (dtheta(j,2,i),j=1,3)
17716 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
17717 !el (dthetanum(j,2,i),j=1,3)
17718 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
17719 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
17720 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
17723 ! Check gamma gradient
17725 "Analytical (upper) and numerical (lower) gradient of gamma"
17729 dc(j,i-3)=dcji+aincr
17730 call chainbuild_cart
17731 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
17734 dc(j,i-2)=dcji+aincr
17735 call chainbuild_cart
17736 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
17739 dc(j,i-1)=dc(j,i-1)+aincr
17740 call chainbuild_cart
17741 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
17744 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
17745 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
17746 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
17747 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
17748 !el write (iout,'(5x,3(3f10.5,5x))') &
17749 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
17750 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
17751 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
17754 ! Check alpha gradient
17756 "Analytical (upper) and numerical (lower) gradient of alpha"
17758 if(itype(i,1).ne.10) then
17761 dc(j,i-1)=dcji+aincr
17762 call chainbuild_cart
17763 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
17768 call chainbuild_cart
17769 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
17773 dc(j,i+nres)=dc(j,i+nres)+aincr
17774 call chainbuild_cart
17775 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
17780 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
17781 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
17782 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
17783 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
17784 !el write (iout,'(5x,3(3f10.5,5x))') &
17785 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
17786 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
17787 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
17790 ! Check omega gradient
17792 "Analytical (upper) and numerical (lower) gradient of omega"
17794 if(itype(i,1).ne.10) then
17797 dc(j,i-1)=dcji+aincr
17798 call chainbuild_cart
17799 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
17804 call chainbuild_cart
17805 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
17809 dc(j,i+nres)=dc(j,i+nres)+aincr
17810 call chainbuild_cart
17811 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
17816 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
17817 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
17818 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
17819 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
17820 !el write (iout,'(5x,3(3f10.5,5x))') &
17821 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
17822 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
17823 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
17827 end subroutine checkintcartgrad
17828 !-----------------------------------------------------------------------------
17830 !-----------------------------------------------------------------------------
17831 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
17832 ! implicit real*8 (a-h,o-z)
17833 ! include 'DIMENSIONS'
17834 ! include 'COMMON.IOUNITS'
17835 ! include 'COMMON.CHAIN'
17836 ! include 'COMMON.INTERACT'
17837 ! include 'COMMON.VAR'
17838 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
17839 integer :: kkk,nsep=3
17840 real(kind=8) :: qm !dist,
17841 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
17842 logical :: lprn=.false.
17844 ! real(kind=8) :: sigm,x
17846 !el sigm(x)=0.25d0*x ! local function
17852 do il=seg1+nsep,seg2
17855 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
17856 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
17857 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17859 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17860 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17863 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17864 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17865 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17866 dijCM=dist(il+nres,jl+nres)
17867 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17869 qq = qq+qqij+qqijCM
17875 if((seg3-il).lt.3) then
17882 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17883 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17884 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17886 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17887 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17890 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17891 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17892 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17893 dijCM=dist(il+nres,jl+nres)
17894 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17896 qq = qq+qqij+qqijCM
17901 if (qqmax.le.qq) qqmax=qq
17903 qwolynes=1.0d0-qqmax
17905 end function qwolynes
17906 !-----------------------------------------------------------------------------
17907 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
17908 ! implicit real*8 (a-h,o-z)
17909 ! include 'DIMENSIONS'
17910 ! include 'COMMON.IOUNITS'
17911 ! include 'COMMON.CHAIN'
17912 ! include 'COMMON.INTERACT'
17913 ! include 'COMMON.VAR'
17914 ! include 'COMMON.MD'
17915 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
17916 integer :: nsep=3, kkk
17917 !el real(kind=8) :: dist
17918 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
17919 logical :: lprn=.false.
17921 real(kind=8) :: sim,dd0,fac,ddqij
17922 !el sigm(x)=0.25d0*x ! local function
17932 do il=seg1+nsep,seg2
17935 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17936 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17937 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17939 sim = 1.0d0/sigm(d0ij)
17942 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17944 ddqij = (c(k,il)-c(k,jl))*fac
17945 dqwol(k,il)=dqwol(k,il)+ddqij
17946 dqwol(k,jl)=dqwol(k,jl)-ddqij
17949 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17952 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17953 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17954 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17955 dijCM=dist(il+nres,jl+nres)
17956 sim = 1.0d0/sigm(d0ijCM)
17959 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17961 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17962 dxqwol(k,il)=dxqwol(k,il)+ddqij
17963 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17970 if((seg3-il).lt.3) then
17977 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17978 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17979 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17981 sim = 1.0d0/sigm(d0ij)
17984 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17986 ddqij = (c(k,il)-c(k,jl))*fac
17987 dqwol(k,il)=dqwol(k,il)+ddqij
17988 dqwol(k,jl)=dqwol(k,jl)-ddqij
17990 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17993 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17994 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17995 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17996 dijCM=dist(il+nres,jl+nres)
17997 sim = 1.0d0/sigm(d0ijCM)
18000 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
18002 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
18003 dxqwol(k,il)=dxqwol(k,il)+ddqij
18004 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
18013 dqwol(j,i)=dqwol(j,i)/nl
18014 dxqwol(j,i)=dxqwol(j,i)/nl
18018 end subroutine qwolynes_prim
18019 !-----------------------------------------------------------------------------
18020 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
18021 ! implicit real*8 (a-h,o-z)
18022 ! include 'DIMENSIONS'
18023 ! include 'COMMON.IOUNITS'
18024 ! include 'COMMON.CHAIN'
18025 ! include 'COMMON.INTERACT'
18026 ! include 'COMMON.VAR'
18027 integer :: seg1,seg2,seg3,seg4
18029 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
18030 real(kind=8),dimension(3,0:2*nres) :: cdummy
18031 real(kind=8) :: q1,q2
18032 real(kind=8) :: delta=1.0d-10
18037 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
18039 c(j,i)=c(j,i)+delta
18040 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
18041 qwolan(j,i)=(q2-q1)/delta
18047 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
18048 cdummy(j,i+nres)=c(j,i+nres)
18049 c(j,i+nres)=c(j,i+nres)+delta
18050 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
18051 qwolxan(j,i)=(q2-q1)/delta
18052 c(j,i+nres)=cdummy(j,i+nres)
18055 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
18057 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
18059 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
18061 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
18064 end subroutine qwol_num
18065 !-----------------------------------------------------------------------------
18066 subroutine EconstrQ
18067 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
18068 ! implicit real*8 (a-h,o-z)
18069 ! include 'DIMENSIONS'
18070 ! include 'COMMON.CONTROL'
18071 ! include 'COMMON.VAR'
18072 ! include 'COMMON.MD'
18075 ! include 'COMMON.LANGEVIN'
18077 ! include 'COMMON.LANGEVIN.lang0'
18079 ! include 'COMMON.CHAIN'
18080 ! include 'COMMON.DERIV'
18081 ! include 'COMMON.GEO'
18082 ! include 'COMMON.LOCAL'
18083 ! include 'COMMON.INTERACT'
18084 ! include 'COMMON.IOUNITS'
18085 ! include 'COMMON.NAMES'
18086 ! include 'COMMON.TIME1'
18087 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
18088 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
18090 integer :: kstart,kend,lstart,lend,idummy
18091 real(kind=8) :: delta=1.0d-7
18092 integer :: i,j,k,ii
18096 dudconst(j,i)=0.0d0
18097 duxconst(j,i)=0.0d0
18098 dudxconst(j,i)=0.0d0
18103 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
18105 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
18106 ! Calculating the derivatives of Constraint energy with respect to Q
18107 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
18109 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
18110 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
18111 ! hmnum=(hm2-hm1)/delta
18112 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
18113 ! & qinfrag(i,iset))
18114 ! write(iout,*) "harmonicnum frag", hmnum
18115 ! Calculating the derivatives of Q with respect to cartesian coordinates
18116 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
18118 ! write(iout,*) "dqwol "
18120 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
18122 ! write(iout,*) "dxqwol "
18124 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
18126 ! Calculating numerical gradients of dU/dQi and dQi/dxi
18127 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
18128 ! & ,idummy,idummy)
18129 ! The gradients of Uconst in Cs
18132 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
18133 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
18138 kstart=ifrag(1,ipair(1,i,iset),iset)
18139 kend=ifrag(2,ipair(1,i,iset),iset)
18140 lstart=ifrag(1,ipair(2,i,iset),iset)
18141 lend=ifrag(2,ipair(2,i,iset),iset)
18142 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
18143 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
18144 ! Calculating dU/dQ
18145 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
18146 ! hm1=harmonic(qpair(i),qinpair(i,iset))
18147 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
18148 ! hmnum=(hm2-hm1)/delta
18149 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
18150 ! & qinpair(i,iset))
18151 ! write(iout,*) "harmonicnum pair ", hmnum
18152 ! Calculating dQ/dXi
18153 call qwolynes_prim(kstart,kend,.false.,&
18155 ! write(iout,*) "dqwol "
18157 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
18159 ! write(iout,*) "dxqwol "
18161 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
18163 ! Calculating numerical gradients
18164 ! call qwol_num(kstart,kend,.false.
18166 ! The gradients of Uconst in Cs
18169 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
18170 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
18174 ! write(iout,*) "Uconst inside subroutine ", Uconst
18175 ! Transforming the gradients from Cs to dCs for the backbone
18179 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
18183 ! Transforming the gradients from Cs to dCs for the side chains
18186 dudxconst(j,i)=duxconst(j,i)
18189 ! write(iout,*) "dU/ddc backbone "
18191 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
18193 ! write(iout,*) "dU/ddX side chain "
18195 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
18197 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
18198 ! call dEconstrQ_num
18200 end subroutine EconstrQ
18201 !-----------------------------------------------------------------------------
18202 subroutine dEconstrQ_num
18203 ! Calculating numerical dUconst/ddc and dUconst/ddx
18204 ! implicit real*8 (a-h,o-z)
18205 ! include 'DIMENSIONS'
18206 ! include 'COMMON.CONTROL'
18207 ! include 'COMMON.VAR'
18208 ! include 'COMMON.MD'
18211 ! include 'COMMON.LANGEVIN'
18213 ! include 'COMMON.LANGEVIN.lang0'
18215 ! include 'COMMON.CHAIN'
18216 ! include 'COMMON.DERIV'
18217 ! include 'COMMON.GEO'
18218 ! include 'COMMON.LOCAL'
18219 ! include 'COMMON.INTERACT'
18220 ! include 'COMMON.IOUNITS'
18221 ! include 'COMMON.NAMES'
18222 ! include 'COMMON.TIME1'
18223 real(kind=8) :: uzap1,uzap2
18224 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
18225 integer :: kstart,kend,lstart,lend,idummy
18226 real(kind=8) :: delta=1.0d-7
18227 !el local variables
18233 dUcartan(j,i)=0.0d0
18234 cdummy(j,i)=dc(j,i)
18235 dc(j,i)=dc(j,i)+delta
18236 call chainbuild_cart
18239 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18241 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
18245 kstart=ifrag(1,ipair(1,ii,iset),iset)
18246 kend=ifrag(2,ipair(1,ii,iset),iset)
18247 lstart=ifrag(1,ipair(2,ii,iset),iset)
18248 lend=ifrag(2,ipair(2,ii,iset),iset)
18249 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18250 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
18253 dc(j,i)=cdummy(j,i)
18254 call chainbuild_cart
18257 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18259 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
18263 kstart=ifrag(1,ipair(1,ii,iset),iset)
18264 kend=ifrag(2,ipair(1,ii,iset),iset)
18265 lstart=ifrag(1,ipair(2,ii,iset),iset)
18266 lend=ifrag(2,ipair(2,ii,iset),iset)
18267 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18268 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
18271 ducartan(j,i)=(uzap2-uzap1)/(delta)
18274 ! Calculating numerical gradients for dU/ddx
18276 duxcartan(j,i)=0.0d0
18278 cdummy(j,i)=dc(j,i+nres)
18279 dc(j,i+nres)=dc(j,i+nres)+delta
18280 call chainbuild_cart
18283 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18285 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
18289 kstart=ifrag(1,ipair(1,ii,iset),iset)
18290 kend=ifrag(2,ipair(1,ii,iset),iset)
18291 lstart=ifrag(1,ipair(2,ii,iset),iset)
18292 lend=ifrag(2,ipair(2,ii,iset),iset)
18293 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18294 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
18297 dc(j,i+nres)=cdummy(j,i)
18298 call chainbuild_cart
18301 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
18302 ifrag(2,ii,iset),.true.,idummy,idummy)
18303 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
18307 kstart=ifrag(1,ipair(1,ii,iset),iset)
18308 kend=ifrag(2,ipair(1,ii,iset),iset)
18309 lstart=ifrag(1,ipair(2,ii,iset),iset)
18310 lend=ifrag(2,ipair(2,ii,iset),iset)
18311 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18312 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
18315 duxcartan(j,i)=(uzap2-uzap1)/(delta)
18318 write(iout,*) "Numerical dUconst/ddc backbone "
18320 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
18322 ! write(iout,*) "Numerical dUconst/ddx side-chain "
18324 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
18327 end subroutine dEconstrQ_num
18328 !-----------------------------------------------------------------------------
18330 !-----------------------------------------------------------------------------
18331 subroutine check_energies
18333 ! use random, only: ran_number
18337 ! include 'DIMENSIONS'
18338 ! include 'COMMON.CHAIN'
18339 ! include 'COMMON.VAR'
18340 ! include 'COMMON.IOUNITS'
18341 ! include 'COMMON.SBRIDGE'
18342 ! include 'COMMON.LOCAL'
18343 ! include 'COMMON.GEO'
18345 ! External functions
18346 !EL double precision ran_number
18347 !EL external ran_number
18350 integer :: i,j,k,l,lmax,p,pmax
18351 real(kind=8) :: rmin,rmax
18352 real(kind=8) :: eij
18355 real(kind=8) :: wi,rij,tj,pj
18377 !t wi=ran_number(0.0D0,pi)
18378 ! wi=ran_number(0.0D0,pi/6.0D0)
18380 !t tj=ran_number(0.0D0,pi)
18381 !t pj=ran_number(0.0D0,pi)
18382 ! pj=ran_number(0.0D0,pi/6.0D0)
18386 !t rij=ran_number(rmin,rmax)
18388 c(1,j)=d*sin(pj)*cos(tj)
18389 c(2,j)=d*sin(pj)*sin(tj)
18395 c(3,i)=-rij-d*cos(wi)
18398 dc(k,nres+i)=c(k,nres+i)-c(k,i)
18399 dc_norm(k,nres+i)=dc(k,nres+i)/d
18400 dc(k,nres+j)=c(k,nres+j)-c(k,j)
18401 dc_norm(k,nres+j)=dc(k,nres+j)/d
18404 call dyn_ssbond_ene(i,j,eij)
18409 end subroutine check_energies
18410 !-----------------------------------------------------------------------------
18411 subroutine dyn_ssbond_ene(resi,resj,eij)
18416 ! include 'DIMENSIONS'
18417 ! include 'COMMON.SBRIDGE'
18418 ! include 'COMMON.CHAIN'
18419 ! include 'COMMON.DERIV'
18420 ! include 'COMMON.LOCAL'
18421 ! include 'COMMON.INTERACT'
18422 ! include 'COMMON.VAR'
18423 ! include 'COMMON.IOUNITS'
18424 ! include 'COMMON.CALC'
18428 ! include 'COMMON.MD'
18429 ! use MD, only: totT,t_bath
18432 ! External functions
18433 !EL double precision h_base
18434 !EL external h_base
18437 integer :: resi,resj
18440 real(kind=8) :: eij
18443 logical :: havebond
18444 integer itypi,itypj
18445 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
18446 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
18447 real(kind=8),dimension(3) :: dcosom1,dcosom2
18449 real(kind=8) :: pom1,pom2
18450 real(kind=8) :: ljA,ljB,ljXs
18451 real(kind=8),dimension(1:3) :: d_ljB
18452 real(kind=8) :: ssA,ssB,ssC,ssXs
18453 real(kind=8) :: ssxm,ljxm,ssm,ljm
18454 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
18455 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
18456 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
18457 !-------FIRST METHOD
18459 real(kind=8),dimension(1:3) :: d_xm
18460 !-------END FIRST METHOD
18461 !-------SECOND METHOD
18462 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
18463 !-------END SECOND METHOD
18465 !-------TESTING CODE
18466 !el logical :: checkstop,transgrad
18467 !el common /sschecks/ checkstop,transgrad
18469 integer :: icheck,nicheck,jcheck,njcheck
18470 real(kind=8),dimension(-1:1) :: echeck
18471 real(kind=8) :: deps,ssx0,ljx0
18472 !-------END TESTING CODE
18478 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
18479 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
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)
18488 xj=c(1,nres+j)-c(1,nres+i)
18489 yj=c(2,nres+j)-c(2,nres+i)
18490 zj=c(3,nres+j)-c(3,nres+i)
18491 dxj=dc_norm(1,nres+j)
18492 dyj=dc_norm(2,nres+j)
18493 dzj=dc_norm(3,nres+j)
18494 dscj_inv=vbld_inv(j+nres)
18496 chi1=chi(itypi,itypj)
18497 chi2=chi(itypj,itypi)
18504 alf12=0.5D0*(alf1+alf2)
18506 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
18507 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18508 ! The following are set in sc_angular
18512 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
18513 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
18514 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
18516 rij=1.0D0/rij ! Reset this so it makes sense
18518 sig0ij=sigma(itypi,itypj)
18519 sig=sig0ij*dsqrt(1.0D0/sigsq)
18522 ljA=eps1*eps2rt**2*eps3rt**2
18523 ljB=ljA*bb_aq(itypi,itypj)
18524 ljA=ljA*aa_aq(itypi,itypj)
18525 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
18530 deltat12=om2-om1+2.0d0
18531 cosphi=om12-om1*om2
18535 +akth*(deltat1*deltat1+deltat2*deltat2) &
18536 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
18537 ssxm=ssXs-0.5D0*ssB/ssA
18539 !-------TESTING CODE
18540 !$$$c Some extra output
18541 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18542 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
18543 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
18544 !$$$ if (ssx0.gt.0.0d0) then
18545 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
18549 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
18550 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
18551 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
18553 !-------END TESTING CODE
18555 !-------TESTING CODE
18556 ! Stop and plot energy and derivative as a function of distance
18557 if (checkstop) then
18558 ssm=ssC-0.25D0*ssB*ssB/ssA
18559 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18560 if (ssm.lt.ljm .and. &
18561 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
18569 if (.not.checkstop) then
18574 do icheck=0,nicheck
18575 do jcheck=-1,njcheck
18576 if (checkstop) rij=(ssxm-1.0d0)+ &
18577 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
18578 !-------END TESTING CODE
18580 if (rij.gt.ljxm) then
18583 fac=(1.0D0/ljd)**expon
18584 e1=fac*fac*aa_aq(itypi,itypj)
18585 e2=fac*bb_aq(itypi,itypj)
18586 eij=eps1*eps2rt*eps3rt*(e1+e2)
18589 eij=eij*eps2rt*eps3rt
18592 e1=e1*eps1*eps2rt**2*eps3rt**2
18593 ed=-expon*(e1+eij)/ljd
18595 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
18596 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
18597 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
18598 -2.0D0*alf12*eps3der+sigder*sigsq_om12
18599 else if (rij.lt.ssxm) then
18602 eij=ssA*ssd*ssd+ssB*ssd+ssC
18604 ed=2*akcm*ssd+akct*deltat12
18606 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
18607 eom1=-2*akth*deltat1-pom1-om2*pom2
18608 eom2= 2*akth*deltat2+pom1-om1*pom2
18611 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
18613 d_ssxm(1)=0.5D0*akct/ssA
18614 d_ssxm(2)=-d_ssxm(1)
18617 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
18618 d_ljxm(2)=d_ljxm(1)*sigsq_om2
18619 d_ljxm(3)=d_ljxm(1)*sigsq_om12
18620 d_ljxm(1)=d_ljxm(1)*sigsq_om1
18622 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18623 xm=0.5d0*(ssxm+ljxm)
18625 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
18627 if (rij.lt.xm) then
18629 ssm=ssC-0.25D0*ssB*ssB/ssA
18630 d_ssm(1)=0.5D0*akct*ssB/ssA
18631 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18632 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18634 f1=(rij-xm)/(ssxm-xm)
18635 f2=(rij-ssxm)/(xm-ssxm)
18639 delta_inv=1.0d0/(xm-ssxm)
18640 deltasq_inv=delta_inv*delta_inv
18642 fac1=deltasq_inv*fac*(xm-rij)
18643 fac2=deltasq_inv*fac*(rij-ssxm)
18644 ed=delta_inv*(Ht*hd2-ssm*hd1)
18645 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
18646 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
18647 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
18650 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18651 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
18652 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
18653 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
18655 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
18656 f1=(rij-ljxm)/(xm-ljxm)
18657 f2=(rij-xm)/(ljxm-xm)
18661 delta_inv=1.0d0/(ljxm-xm)
18662 deltasq_inv=delta_inv*delta_inv
18664 fac1=deltasq_inv*fac*(ljxm-rij)
18665 fac2=deltasq_inv*fac*(rij-xm)
18666 ed=delta_inv*(ljm*hd2-Ht*hd1)
18667 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
18668 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
18669 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
18671 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18673 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18679 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
18680 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
18681 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
18683 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18684 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
18685 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18686 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18687 !$$$ d_ssm(3)=omega
18689 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
18691 !$$$ d_ljm(k)=ljm*d_ljB(k)
18695 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
18696 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
18697 !$$$ d_ss(2)=akct*ssd
18698 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
18699 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
18702 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
18703 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
18704 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
18706 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
18707 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
18709 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
18711 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
18712 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
18713 !$$$ h1=h_base(f1,hd1)
18714 !$$$ h2=h_base(f2,hd2)
18715 !$$$ eij=ss*h1+ljf*h2
18716 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
18717 !$$$ deltasq_inv=delta_inv*delta_inv
18718 !$$$ fac=ljf*hd2-ss*hd1
18719 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
18720 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
18721 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
18722 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
18723 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
18724 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
18725 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
18727 !$$$ havebond=.false.
18728 !$$$ if (ed.gt.0.0d0) havebond=.true.
18729 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18736 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
18737 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18738 ! & "SSBOND_E_FORM",totT,t_bath,i,j
18742 dyn_ssbond_ij(i,j)=eij
18743 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
18744 dyn_ssbond_ij(i,j)=1.0d300
18747 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18748 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
18753 !-------TESTING CODE
18754 !el if (checkstop) then
18755 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
18756 "CHECKSTOP",rij,eij,ed
18760 if (checkstop) then
18761 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
18764 if (checkstop) then
18768 !-------END TESTING CODE
18771 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
18772 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
18775 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
18778 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
18779 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
18780 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
18781 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
18782 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
18783 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
18787 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
18792 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18793 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18797 end subroutine dyn_ssbond_ene
18798 !--------------------------------------------------------------------------
18799 subroutine triple_ssbond_ene(resi,resj,resk,eij)
18804 ! include 'DIMENSIONS'
18805 ! include 'COMMON.SBRIDGE'
18806 ! include 'COMMON.CHAIN'
18807 ! include 'COMMON.DERIV'
18808 ! include 'COMMON.LOCAL'
18809 ! include 'COMMON.INTERACT'
18810 ! include 'COMMON.VAR'
18811 ! include 'COMMON.IOUNITS'
18812 ! include 'COMMON.CALC'
18816 ! include 'COMMON.MD'
18817 ! use MD, only: totT,t_bath
18820 double precision h_base
18824 integer resi,resj,resk,m,itypi,itypj,itypk
18826 !c Output arguments
18827 double precision eij,eij1,eij2,eij3
18831 !c integer itypi,itypj,k,l
18832 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
18833 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
18834 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
18835 double precision sig0ij,ljd,sig,fac,e1,e2
18836 double precision dcosom1(3),dcosom2(3),ed
18837 double precision pom1,pom2
18838 double precision ljA,ljB,ljXs
18839 double precision d_ljB(1:3)
18840 double precision ssA,ssB,ssC,ssXs
18841 double precision ssxm,ljxm,ssm,ljm
18842 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
18844 if (dtriss.eq.0) return
18848 !C write(iout,*) resi,resj,resk
18850 dxi=dc_norm(1,nres+i)
18851 dyi=dc_norm(2,nres+i)
18852 dzi=dc_norm(3,nres+i)
18853 dsci_inv=vbld_inv(i+nres)
18857 call to_box(xi,yi,zi)
18862 call to_box(xj,yj,zj)
18863 dxj=dc_norm(1,nres+j)
18864 dyj=dc_norm(2,nres+j)
18865 dzj=dc_norm(3,nres+j)
18866 dscj_inv=vbld_inv(j+nres)
18871 call to_box(xk,yk,zk)
18872 dxk=dc_norm(1,nres+k)
18873 dyk=dc_norm(2,nres+k)
18874 dzk=dc_norm(3,nres+k)
18875 dscj_inv=vbld_inv(k+nres)
18885 rrij=(xij*xij+yij*yij+zij*zij)
18886 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18887 rrik=(xik*xik+yik*yik+zik*zik)
18889 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
18891 !C there are three combination of distances for each trisulfide bonds
18892 !C The first case the ith atom is the center
18893 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
18894 !C distance y is second distance the a,b,c,d are parameters derived for
18895 !C this problem d parameter was set as a penalty currenlty set to 1.
18896 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
18899 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
18901 !C second case jth atom is center
18902 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
18905 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
18907 !C the third case kth atom is the center
18908 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
18911 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
18917 !C write(iout,*)i,j,k,eij
18918 !C The energy penalty calculated now time for the gradient part
18919 !C derivative over rij
18920 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18921 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
18926 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18927 gvdwx(m,j)=gvdwx(m,j)+gg(m)
18931 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18932 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18934 !C now derivative over rik
18935 fac=-eij1**2/dtriss* &
18936 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18937 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18942 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18943 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18946 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18947 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18949 !C now derivative over rjk
18950 fac=-eij2**2/dtriss* &
18951 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18952 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18957 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18958 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18961 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18962 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18965 end subroutine triple_ssbond_ene
18969 !-----------------------------------------------------------------------------
18970 real(kind=8) function h_base(x,deriv)
18971 ! A smooth function going 0->1 in range [0,1]
18972 ! It should NOT be called outside range [0,1], it will not work there.
18979 real(kind=8) :: deriv
18982 real(kind=8) :: xsq
18985 ! Two parabolas put together. First derivative zero at extrema
18986 !$$$ if (x.lt.0.5D0) then
18987 !$$$ h_base=2.0D0*x*x
18991 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18992 !$$$ deriv=4.0D0*deriv
18995 ! Third degree polynomial. First derivative zero at extrema
18996 h_base=x*x*(3.0d0-2.0d0*x)
18997 deriv=6.0d0*x*(1.0d0-x)
18999 ! Fifth degree polynomial. First and second derivatives zero at extrema
19001 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
19003 !$$$ deriv=deriv*deriv
19004 !$$$ deriv=30.0d0*xsq*deriv
19007 end function h_base
19008 !-----------------------------------------------------------------------------
19009 subroutine dyn_set_nss
19010 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
19012 use MD_data, only: totT,t_bath
19014 ! include 'DIMENSIONS'
19018 ! include 'COMMON.SBRIDGE'
19019 ! include 'COMMON.CHAIN'
19020 ! include 'COMMON.IOUNITS'
19021 ! include 'COMMON.SETUP'
19022 ! include 'COMMON.MD'
19024 real(kind=8) :: emin
19025 integer :: i,j,imin,ierr
19026 integer :: diff,allnss,newnss
19027 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
19030 integer,dimension(0:nfgtasks) :: i_newnss
19031 integer,dimension(0:nfgtasks) :: displ
19032 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
19033 integer :: g_newnss
19038 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
19047 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
19051 if (allflag(i).eq.0 .and. &
19052 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
19053 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
19057 if (emin.lt.1.0d300) then
19060 if (allflag(i).eq.0 .and. &
19061 (allihpb(i).eq.allihpb(imin) .or. &
19062 alljhpb(i).eq.allihpb(imin) .or. &
19063 allihpb(i).eq.alljhpb(imin) .or. &
19064 alljhpb(i).eq.alljhpb(imin))) then
19071 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
19075 if (allflag(i).eq.1) then
19077 newihpb(newnss)=allihpb(i)
19078 newjhpb(newnss)=alljhpb(i)
19083 if (nfgtasks.gt.1)then
19085 call MPI_Reduce(newnss,g_newnss,1,&
19086 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
19087 call MPI_Gather(newnss,1,MPI_INTEGER,&
19088 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
19090 do i=1,nfgtasks-1,1
19091 displ(i)=i_newnss(i-1)+displ(i-1)
19093 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
19094 g_newihpb,i_newnss,displ,MPI_INTEGER,&
19096 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
19097 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
19099 if(fg_rank.eq.0) then
19100 ! print *,'g_newnss',g_newnss
19101 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
19102 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
19105 newihpb(i)=g_newihpb(i)
19106 newjhpb(i)=g_newjhpb(i)
19114 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
19115 ! print *,newnss,nss,maxdim
19121 if (idssb(i).eq.newihpb(j) .and. &
19122 jdssb(i).eq.newjhpb(j)) found=.true.
19124 #if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
19125 ! write(iout,*) "found",found,i,j
19126 if (.not.found.and.fg_rank.eq.0) &
19127 write(iout,'(a15,f12.2,f8.1,2i5)') &
19128 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
19136 if (newihpb(i).eq.idssb(j) .and. &
19137 newjhpb(i).eq.jdssb(j)) found=.true.
19139 #if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
19140 ! write(iout,*) "found",found,i,j
19141 if (.not.found.and.fg_rank.eq.0) &
19142 write(iout,'(a15,f12.2,f8.1,2i5)') &
19143 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
19146 !#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
19149 idssb(i)=newihpb(i)
19150 jdssb(i)=newjhpb(i)
19157 end subroutine dyn_set_nss
19158 ! Lipid transfer energy function
19159 subroutine Eliptransfer(eliptran)
19160 !C this is done by Adasko
19161 !C print *,"wchodze"
19162 !C structure of box:
19164 !C--bordliptop-- buffore starts
19165 !C--bufliptop--- here true lipid starts
19167 !C--buflipbot--- lipid ends buffore starts
19168 !C--bordlipbot--buffore ends
19169 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
19172 ! print *, "I am in eliptran"
19173 do i=ilip_start,ilip_end
19175 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
19178 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
19179 if (positi.le.0.0) positi=positi+boxzsize
19181 !C first for peptide groups
19182 !c for each residue check if it is in lipid or lipid water border area
19183 if ((positi.gt.bordlipbot) &
19184 .and.(positi.lt.bordliptop)) then
19185 !C the energy transfer exist
19186 if (positi.lt.buflipbot) then
19187 !C what fraction I am in
19189 ((positi-bordlipbot)/lipbufthick)
19190 !C lipbufthick is thickenes of lipid buffore
19191 sslip=sscalelip(fracinbuf)
19192 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
19193 eliptran=eliptran+sslip*pepliptran
19194 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
19195 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
19196 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
19198 !C print *,"doing sccale for lower part"
19199 !C print *,i,sslip,fracinbuf,ssgradlip
19200 elseif (positi.gt.bufliptop) then
19201 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
19202 sslip=sscalelip(fracinbuf)
19203 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
19204 eliptran=eliptran+sslip*pepliptran
19205 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
19206 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
19207 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
19208 !C print *, "doing sscalefor top part"
19209 !C print *,i,sslip,fracinbuf,ssgradlip
19211 eliptran=eliptran+pepliptran
19212 !C print *,"I am in true lipid"
19215 !C eliptran=elpitran+0.0 ! I am in water
19217 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
19219 ! here starts the side chain transfer
19220 do i=ilip_start,ilip_end
19221 if (itype(i,1).eq.ntyp1) cycle
19222 positi=(mod(c(3,i+nres),boxzsize))
19223 if (positi.le.0) positi=positi+boxzsize
19224 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19225 !c for each residue check if it is in lipid or lipid water border area
19226 !C respos=mod(c(3,i+nres),boxzsize)
19227 !C print *,positi,bordlipbot,buflipbot
19228 if ((positi.gt.bordlipbot) &
19229 .and.(positi.lt.bordliptop)) then
19230 !C the energy transfer exist
19231 if (positi.lt.buflipbot) then
19233 ((positi-bordlipbot)/lipbufthick)
19234 !C lipbufthick is thickenes of lipid buffore
19235 sslip=sscalelip(fracinbuf)
19236 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
19237 eliptran=eliptran+sslip*liptranene(itype(i,1))
19238 gliptranx(3,i)=gliptranx(3,i) &
19239 +ssgradlip*liptranene(itype(i,1))
19240 gliptranc(3,i-1)= gliptranc(3,i-1) &
19241 +ssgradlip*liptranene(itype(i,1))
19242 !C print *,"doing sccale for lower part"
19243 elseif (positi.gt.bufliptop) then
19245 ((bordliptop-positi)/lipbufthick)
19246 sslip=sscalelip(fracinbuf)
19247 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
19248 eliptran=eliptran+sslip*liptranene(itype(i,1))
19249 gliptranx(3,i)=gliptranx(3,i) &
19250 +ssgradlip*liptranene(itype(i,1))
19251 gliptranc(3,i-1)= gliptranc(3,i-1) &
19252 +ssgradlip*liptranene(itype(i,1))
19253 !C print *, "doing sscalefor top part",sslip,fracinbuf
19255 eliptran=eliptran+liptranene(itype(i,1))
19256 !C print *,"I am in true lipid"
19258 endif ! if in lipid or buffor
19260 !C eliptran=elpitran+0.0 ! I am in water
19261 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
19264 end subroutine Eliptransfer
19265 !----------------------------------NANO FUNCTIONS
19266 !C-----------------------------------------------------------------------
19267 !C-----------------------------------------------------------
19268 !C This subroutine is to mimic the histone like structure but as well can be
19269 !C utilizet to nanostructures (infinit) small modification has to be used to
19270 !C make it finite (z gradient at the ends has to be changes as well as the x,y
19271 !C gradient has to be modified at the ends
19272 !C The energy function is Kihara potential
19273 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
19274 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
19275 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
19276 !C simple Kihara potential
19277 subroutine calctube(Etube)
19278 real(kind=8),dimension(3) :: vectube
19279 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19280 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
19281 sc_aa_tube,sc_bb_tube
19284 do i=itube_start,itube_end
19286 enetube(i+nres)=0.0d0
19288 !C first we calculate the distance from tube center
19290 do i=itube_start,itube_end
19291 !C lets ommit dummy atoms for now
19292 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19293 !C now calculate distance from center of tube and direction vectors
19296 ! Find minimum distance in periodic box
19298 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19299 vectube(1)=vectube(1)+boxxsize*j
19300 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19301 vectube(2)=vectube(2)+boxysize*j
19302 xminact=abs(vectube(1)-tubecenter(1))
19303 yminact=abs(vectube(2)-tubecenter(2))
19304 if (xmin.gt.xminact) then
19308 if (ymin.gt.yminact) then
19315 vectube(1)=vectube(1)-tubecenter(1)
19316 vectube(2)=vectube(2)-tubecenter(2)
19318 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19319 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19321 !C as the tube is infinity we do not calculate the Z-vector use of Z
19324 !C now calculte the distance
19325 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19326 !C now normalize vector
19327 vectube(1)=vectube(1)/tub_r
19328 vectube(2)=vectube(2)/tub_r
19329 !C calculte rdiffrence between r and r0
19332 rdiff6=rdiff**6.0d0
19333 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19334 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19335 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19336 !C print *,rdiff,rdiff6,pep_aa_tube
19337 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19338 !C now we calculate gradient
19339 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19340 6.0d0*pep_bb_tube)/rdiff6/rdiff
19341 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19343 !C now direction of gg_tube vector
19345 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19346 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19349 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
19350 !C print *,gg_tube(1,0),"TU"
19353 do i=itube_start,itube_end
19354 !C Lets not jump over memory as we use many times iti
19356 !C lets ommit dummy atoms for now
19357 if ((iti.eq.ntyp1) &
19358 !C in UNRES uncomment the line below as GLY has no side-chain...
19364 vectube(1)=mod((c(1,i+nres)),boxxsize)
19365 vectube(1)=vectube(1)+boxxsize*j
19366 vectube(2)=mod((c(2,i+nres)),boxysize)
19367 vectube(2)=vectube(2)+boxysize*j
19369 xminact=abs(vectube(1)-tubecenter(1))
19370 yminact=abs(vectube(2)-tubecenter(2))
19371 if (xmin.gt.xminact) then
19375 if (ymin.gt.yminact) then
19382 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19384 vectube(1)=vectube(1)-tubecenter(1)
19385 vectube(2)=vectube(2)-tubecenter(2)
19387 !C as the tube is infinity we do not calculate the Z-vector use of Z
19390 !C now calculte the distance
19391 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19392 !C now normalize vector
19393 vectube(1)=vectube(1)/tub_r
19394 vectube(2)=vectube(2)/tub_r
19396 !C calculte rdiffrence between r and r0
19399 rdiff6=rdiff**6.0d0
19400 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19401 sc_aa_tube=sc_aa_tube_par(iti)
19402 sc_bb_tube=sc_bb_tube_par(iti)
19403 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19404 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19405 6.0d0*sc_bb_tube/rdiff6/rdiff
19406 !C now direction of gg_tube vector
19408 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19409 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19412 do i=itube_start,itube_end
19413 Etube=Etube+enetube(i)+enetube(i+nres)
19415 !C print *,"ETUBE", etube
19417 end subroutine calctube
19418 !C TO DO 1) add to total energy
19419 !C 2) add to gradient summation
19420 !C 3) add reading parameters (AND of course oppening of PARAM file)
19421 !C 4) add reading the center of tube
19423 !C 6) add to zerograd
19424 !C 7) allocate matrices
19427 !C-----------------------------------------------------------------------
19428 !C-----------------------------------------------------------
19429 !C This subroutine is to mimic the histone like structure but as well can be
19430 !C utilizet to nanostructures (infinit) small modification has to be used to
19431 !C make it finite (z gradient at the ends has to be changes as well as the x,y
19432 !C gradient has to be modified at the ends
19433 !C The energy function is Kihara potential
19434 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
19435 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
19436 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
19437 !C simple Kihara potential
19438 subroutine calctube2(Etube)
19439 real(kind=8),dimension(3) :: vectube
19440 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19441 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
19442 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
19445 do i=itube_start,itube_end
19447 enetube(i+nres)=0.0d0
19449 !C first we calculate the distance from tube center
19450 !C first sugare-phosphate group for NARES this would be peptide group
19452 do i=itube_start,itube_end
19453 !C lets ommit dummy atoms for now
19455 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19456 !C now calculate distance from center of tube and direction vectors
19457 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19458 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19459 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19460 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19464 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19465 vectube(1)=vectube(1)+boxxsize*j
19466 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19467 vectube(2)=vectube(2)+boxysize*j
19469 xminact=abs(vectube(1)-tubecenter(1))
19470 yminact=abs(vectube(2)-tubecenter(2))
19471 if (xmin.gt.xminact) then
19475 if (ymin.gt.yminact) then
19482 vectube(1)=vectube(1)-tubecenter(1)
19483 vectube(2)=vectube(2)-tubecenter(2)
19485 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19486 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19488 !C as the tube is infinity we do not calculate the Z-vector use of Z
19491 !C now calculte the distance
19492 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19493 !C now normalize vector
19494 vectube(1)=vectube(1)/tub_r
19495 vectube(2)=vectube(2)/tub_r
19496 !C calculte rdiffrence between r and r0
19499 rdiff6=rdiff**6.0d0
19500 !C THIS FRAGMENT MAKES TUBE FINITE
19501 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19502 if (positi.le.0) positi=positi+boxzsize
19503 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19504 !c for each residue check if it is in lipid or lipid water border area
19505 !C respos=mod(c(3,i+nres),boxzsize)
19506 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19507 if ((positi.gt.bordtubebot) &
19508 .and.(positi.lt.bordtubetop)) then
19509 !C the energy transfer exist
19510 if (positi.lt.buftubebot) then
19512 ((positi-bordtubebot)/tubebufthick)
19513 !C lipbufthick is thickenes of lipid buffore
19514 sstube=sscalelip(fracinbuf)
19515 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19516 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19517 enetube(i)=enetube(i)+sstube*tubetranenepep
19518 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19519 !C &+ssgradtube*tubetranene(itype(i,1))
19520 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19521 !C &+ssgradtube*tubetranene(itype(i,1))
19522 !C print *,"doing sccale for lower part"
19523 elseif (positi.gt.buftubetop) then
19525 ((bordtubetop-positi)/tubebufthick)
19526 sstube=sscalelip(fracinbuf)
19527 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19528 enetube(i)=enetube(i)+sstube*tubetranenepep
19529 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19530 !C &+ssgradtube*tubetranene(itype(i,1))
19531 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19532 !C &+ssgradtube*tubetranene(itype(i,1))
19533 !C print *, "doing sscalefor top part",sslip,fracinbuf
19537 enetube(i)=enetube(i)+sstube*tubetranenepep
19538 !C print *,"I am in true lipid"
19542 !C ssgradtube=0.0d0
19544 endif ! if in lipid or buffor
19546 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19547 enetube(i)=enetube(i)+sstube* &
19548 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
19549 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19550 !C print *,rdiff,rdiff6,pep_aa_tube
19551 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19552 !C now we calculate gradient
19553 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19554 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
19555 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19558 !C now direction of gg_tube vector
19560 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19561 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19563 gg_tube(3,i)=gg_tube(3,i) &
19564 +ssgradtube*enetube(i)/sstube/2.0d0
19565 gg_tube(3,i-1)= gg_tube(3,i-1) &
19566 +ssgradtube*enetube(i)/sstube/2.0d0
19569 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
19570 !C print *,gg_tube(1,0),"TU"
19571 do i=itube_start,itube_end
19572 !C Lets not jump over memory as we use many times iti
19574 !C lets ommit dummy atoms for now
19575 if ((iti.eq.ntyp1) &
19576 !!C in UNRES uncomment the line below as GLY has no side-chain...
19579 vectube(1)=c(1,i+nres)
19580 vectube(1)=mod(vectube(1),boxxsize)
19581 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19582 vectube(2)=c(2,i+nres)
19583 vectube(2)=mod(vectube(2),boxysize)
19584 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19586 vectube(1)=vectube(1)-tubecenter(1)
19587 vectube(2)=vectube(2)-tubecenter(2)
19588 !C THIS FRAGMENT MAKES TUBE FINITE
19589 positi=(mod(c(3,i+nres),boxzsize))
19590 if (positi.le.0) positi=positi+boxzsize
19591 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19592 !c for each residue check if it is in lipid or lipid water border area
19593 !C respos=mod(c(3,i+nres),boxzsize)
19594 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19596 if ((positi.gt.bordtubebot) &
19597 .and.(positi.lt.bordtubetop)) then
19598 !C the energy transfer exist
19599 if (positi.lt.buftubebot) then
19601 ((positi-bordtubebot)/tubebufthick)
19602 !C lipbufthick is thickenes of lipid buffore
19603 sstube=sscalelip(fracinbuf)
19604 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19605 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19606 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19607 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19608 !C &+ssgradtube*tubetranene(itype(i,1))
19609 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19610 !C &+ssgradtube*tubetranene(itype(i,1))
19611 !C print *,"doing sccale for lower part"
19612 elseif (positi.gt.buftubetop) then
19614 ((bordtubetop-positi)/tubebufthick)
19616 sstube=sscalelip(fracinbuf)
19617 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19618 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19619 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19620 !C &+ssgradtube*tubetranene(itype(i,1))
19621 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19622 !C &+ssgradtube*tubetranene(itype(i,1))
19623 !C print *, "doing sscalefor top part",sslip,fracinbuf
19627 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19628 !C print *,"I am in true lipid"
19632 !C ssgradtube=0.0d0
19634 endif ! if in lipid or buffor
19635 !CEND OF FINITE FRAGMENT
19636 !C as the tube is infinity we do not calculate the Z-vector use of Z
19639 !C now calculte the distance
19640 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19641 !C now normalize vector
19642 vectube(1)=vectube(1)/tub_r
19643 vectube(2)=vectube(2)/tub_r
19644 !C calculte rdiffrence between r and r0
19647 rdiff6=rdiff**6.0d0
19648 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19649 sc_aa_tube=sc_aa_tube_par(iti)
19650 sc_bb_tube=sc_bb_tube_par(iti)
19651 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
19652 *sstube+enetube(i+nres)
19653 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19654 !C now we calculate gradient
19655 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
19656 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
19657 !C now direction of gg_tube vector
19659 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19660 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19662 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
19663 +ssgradtube*enetube(i+nres)/sstube
19664 gg_tube(3,i-1)= gg_tube(3,i-1) &
19665 +ssgradtube*enetube(i+nres)/sstube
19668 do i=itube_start,itube_end
19669 Etube=Etube+enetube(i)+enetube(i+nres)
19671 !C print *,"ETUBE", etube
19673 end subroutine calctube2
19674 !=====================================================================================================================================
19675 subroutine calcnano(Etube)
19676 real(kind=8),dimension(3) :: vectube
19678 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19679 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
19680 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
19681 integer:: i,j,iti,r
19684 ! print *,itube_start,itube_end,"poczatek"
19685 do i=itube_start,itube_end
19687 enetube(i+nres)=0.0d0
19689 !C first we calculate the distance from tube center
19690 !C first sugare-phosphate group for NARES this would be peptide group
19692 do i=itube_start,itube_end
19693 !C lets ommit dummy atoms for now
19694 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19695 !C now calculate distance from center of tube and direction vectors
19701 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19702 vectube(1)=vectube(1)+boxxsize*j
19703 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19704 vectube(2)=vectube(2)+boxysize*j
19705 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19706 vectube(3)=vectube(3)+boxzsize*j
19709 xminact=dabs(vectube(1)-tubecenter(1))
19710 yminact=dabs(vectube(2)-tubecenter(2))
19711 zminact=dabs(vectube(3)-tubecenter(3))
19713 if (xmin.gt.xminact) then
19717 if (ymin.gt.yminact) then
19721 if (zmin.gt.zminact) then
19730 vectube(1)=vectube(1)-tubecenter(1)
19731 vectube(2)=vectube(2)-tubecenter(2)
19732 vectube(3)=vectube(3)-tubecenter(3)
19734 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19735 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19736 !C as the tube is infinity we do not calculate the Z-vector use of Z
19738 !C vectube(3)=0.0d0
19739 !C now calculte the distance
19740 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19741 !C now normalize vector
19742 vectube(1)=vectube(1)/tub_r
19743 vectube(2)=vectube(2)/tub_r
19744 vectube(3)=vectube(3)/tub_r
19745 !C calculte rdiffrence between r and r0
19748 rdiff6=rdiff**6.0d0
19749 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19750 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19751 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19752 !C print *,rdiff,rdiff6,pep_aa_tube
19753 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19754 !C now we calculate gradient
19755 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19756 6.0d0*pep_bb_tube)/rdiff6/rdiff
19757 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19759 if (acavtubpep.eq.0.0d0) then
19764 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
19766 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
19769 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
19770 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
19771 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
19772 /denominator**2.0d0
19777 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
19779 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19780 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19784 do i=itube_start,itube_end
19785 enecavtube(i)=0.0d0
19786 !C Lets not jump over memory as we use many times iti
19788 !C lets ommit dummy atoms for now
19789 if ((iti.eq.ntyp1) &
19790 !C in UNRES uncomment the line below as GLY has no side-chain...
19797 vectube(1)=dmod((c(1,i+nres)),boxxsize)
19798 vectube(1)=vectube(1)+boxxsize*j
19799 vectube(2)=dmod((c(2,i+nres)),boxysize)
19800 vectube(2)=vectube(2)+boxysize*j
19801 vectube(3)=dmod((c(3,i+nres)),boxzsize)
19802 vectube(3)=vectube(3)+boxzsize*j
19805 xminact=dabs(vectube(1)-tubecenter(1))
19806 yminact=dabs(vectube(2)-tubecenter(2))
19807 zminact=dabs(vectube(3)-tubecenter(3))
19809 if (xmin.gt.xminact) then
19813 if (ymin.gt.yminact) then
19817 if (zmin.gt.zminact) then
19826 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19828 vectube(1)=vectube(1)-tubecenter(1)
19829 vectube(2)=vectube(2)-tubecenter(2)
19830 vectube(3)=vectube(3)-tubecenter(3)
19831 !C now calculte the distance
19832 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19833 !C now normalize vector
19834 vectube(1)=vectube(1)/tub_r
19835 vectube(2)=vectube(2)/tub_r
19836 vectube(3)=vectube(3)/tub_r
19838 !C calculte rdiffrence between r and r0
19841 rdiff6=rdiff**6.0d0
19842 sc_aa_tube=sc_aa_tube_par(iti)
19843 sc_bb_tube=sc_bb_tube_par(iti)
19844 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19845 !C enetube(i+nres)=0.0d0
19846 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19847 !C now we calculate gradient
19848 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19849 6.0d0*sc_bb_tube/rdiff6/rdiff
19851 !C now direction of gg_tube vector
19852 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
19853 if (acavtub(iti).eq.0.0d0) then
19855 enecavtube(i+nres)=0.0d0
19858 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
19859 enecavtube(i+nres)= &
19860 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
19862 !C enecavtube(i)=0.0
19863 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
19864 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
19865 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
19866 /denominator**2.0d0
19871 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
19872 !C & enecavtube(i),faccav
19873 !C print *,"licz=",
19874 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
19875 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
19877 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19878 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19880 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
19885 do i=itube_start,itube_end
19886 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
19887 +enecavtube(i+nres)
19890 ! print *,"begin", i,"a"
19893 ! rdiff6=rdiff**6.0d0
19894 ! sc_aa_tube=sc_aa_tube_par(i)
19895 ! sc_bb_tube=sc_bb_tube_par(i)
19896 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19897 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
19899 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
19902 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
19904 ! print *,"end",i,"a"
19906 !C print *,"ETUBE", etube
19908 end subroutine calcnano
19910 !===============================================
19911 !--------------------------------------------------------------------------------
19912 !C first for shielding is setting of function of side-chains
19914 subroutine set_shield_fac2
19915 real(kind=8) :: div77_81=0.974996043d0, &
19916 div4_81=0.2222222222d0
19917 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
19918 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
19919 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
19920 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
19921 !C the vector between center of side_chain and peptide group
19922 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
19923 pept_group,costhet_grad,cosphi_grad_long, &
19924 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
19925 sh_frac_dist_grad,pep_side
19927 !C write(2,*) "ivec",ivec_start,ivec_end
19929 fac_shield(i)=0.0d0
19932 grad_shield(j,i)=0.0d0
19935 do i=ivec_start,ivec_end
19937 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19938 ! ishield_list(i)=0
19939 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19940 !Cif there two consequtive dummy atoms there is no peptide group between them
19941 !C the line below has to be changed for FGPROC>1
19944 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
19948 !C first lets set vector conecting the ithe side-chain with kth side-chain
19949 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
19950 !C pep_side(j)=2.0d0
19951 !C and vector conecting the side-chain with its proper calfa
19952 side_calf(j)=c(j,k+nres)-c(j,k)
19953 !C side_calf(j)=2.0d0
19954 pept_group(j)=c(j,i)-c(j,i+1)
19955 !C lets have their lenght
19956 dist_pep_side=pep_side(j)**2+dist_pep_side
19957 dist_side_calf=dist_side_calf+side_calf(j)**2
19958 dist_pept_group=dist_pept_group+pept_group(j)**2
19960 dist_pep_side=sqrt(dist_pep_side)
19961 dist_pept_group=sqrt(dist_pept_group)
19962 dist_side_calf=sqrt(dist_side_calf)
19964 pep_side_norm(j)=pep_side(j)/dist_pep_side
19965 side_calf_norm(j)=dist_side_calf
19967 !C now sscale fraction
19968 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19969 ! print *,buff_shield,"buff",sh_frac_dist
19971 if (sh_frac_dist.le.0.0) cycle
19972 !C print *,ishield_list(i),i
19973 !C If we reach here it means that this side chain reaches the shielding sphere
19974 !C Lets add him to the list for gradient
19975 ishield_list(i)=ishield_list(i)+1
19976 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19977 !C this list is essential otherwise problem would be O3
19978 shield_list(ishield_list(i),i)=k
19979 !C Lets have the sscale value
19980 if (sh_frac_dist.gt.1.0) then
19981 scale_fac_dist=1.0d0
19983 sh_frac_dist_grad(j)=0.0d0
19986 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19987 *(2.0d0*sh_frac_dist-3.0d0)
19988 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19989 /dist_pep_side/buff_shield*0.5d0
19991 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19992 !C sh_frac_dist_grad(j)=0.0d0
19993 !C scale_fac_dist=1.0d0
19994 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19995 !C & sh_frac_dist_grad(j)
19998 !C this is what is now we have the distance scaling now volume...
19999 short=short_r_sidechain(itype(k,1))
20000 long=long_r_sidechain(itype(k,1))
20001 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
20002 sinthet=short/dist_pep_side*costhet
20003 ! print *,"SORT",short,long,sinthet,costhet
20004 !C now costhet_grad
20007 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
20008 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
20009 !C & -short/dist_pep_side**2/costhet)
20010 !C costhet_fac=0.0d0
20012 costhet_grad(j)=costhet_fac*pep_side(j)
20014 !C remember for the final gradient multiply costhet_grad(j)
20015 !C for side_chain by factor -2 !
20016 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
20017 !C pep_side0pept_group is vector multiplication
20018 pep_side0pept_group=0.0d0
20020 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
20022 cosalfa=(pep_side0pept_group/ &
20023 (dist_pep_side*dist_side_calf))
20024 fac_alfa_sin=1.0d0-cosalfa**2
20025 fac_alfa_sin=dsqrt(fac_alfa_sin)
20026 rkprim=fac_alfa_sin*(long-short)+short
20029 !C now costhet_grad
20030 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
20032 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
20033 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
20037 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
20038 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
20039 *(long-short)/fac_alfa_sin*cosalfa/ &
20040 ((dist_pep_side*dist_side_calf))* &
20041 ((side_calf(j))-cosalfa* &
20042 ((pep_side(j)/dist_pep_side)*dist_side_calf))
20043 !C cosphi_grad_long(j)=0.0d0
20044 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
20045 *(long-short)/fac_alfa_sin*cosalfa &
20046 /((dist_pep_side*dist_side_calf))* &
20048 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
20049 !C cosphi_grad_loc(j)=0.0d0
20051 !C print *,sinphi,sinthet
20052 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
20055 !C now the gradient...
20057 grad_shield(j,i)=grad_shield(j,i) &
20058 !C gradient po skalowaniu
20059 +(sh_frac_dist_grad(j)*VofOverlap &
20060 !C gradient po costhet
20061 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
20062 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
20063 sinphi/sinthet*costhet*costhet_grad(j) &
20064 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
20066 !C grad_shield_side is Cbeta sidechain gradient
20067 grad_shield_side(j,ishield_list(i),i)=&
20068 (sh_frac_dist_grad(j)*-2.0d0&
20070 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
20071 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
20072 sinphi/sinthet*costhet*costhet_grad(j)&
20073 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
20075 ! print *, 1.0d0/(-dsqrt(1.0d0-sinphi*sinthet)),&
20077 ! +sinthet/sinphi,"HERE"
20078 grad_shield_loc(j,ishield_list(i),i)= &
20079 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
20080 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
20081 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
20084 ! print *,grad_shield_loc(j,ishield_list(i),i)
20086 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
20088 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
20090 ! write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
20093 end subroutine set_shield_fac2
20094 !----------------------------------------------------------------------------
20095 ! SOUBROUTINE FOR AFM
20096 subroutine AFMvel(Eafmforce)
20097 use MD_data, only:totTafm
20098 real(kind=8),dimension(3) :: diffafm
20099 real(kind=8) :: afmdist,Eafmforce
20101 !C Only for check grad COMMENT if not used for checkgrad
20103 !C--------------------------------------------------------
20104 !C print *,"wchodze"
20108 diffafm(i)=c(i,afmend)-c(i,afmbeg)
20109 afmdist=afmdist+diffafm(i)**2
20111 afmdist=dsqrt(afmdist)
20113 Eafmforce=0.5d0*forceAFMconst &
20114 *(distafminit+totTafm*velAFMconst-afmdist)**2
20115 !C Eafmforce=-forceAFMconst*(dist-distafminit)
20117 gradafm(i,afmend-1)=-forceAFMconst* &
20118 (distafminit+totTafm*velAFMconst-afmdist) &
20119 *diffafm(i)/afmdist
20120 gradafm(i,afmbeg-1)=forceAFMconst* &
20121 (distafminit+totTafm*velAFMconst-afmdist) &
20122 *diffafm(i)/afmdist
20124 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
20126 end subroutine AFMvel
20127 !---------------------------------------------------------
20128 subroutine AFMforce(Eafmforce)
20130 real(kind=8),dimension(3) :: diffafm
20131 ! real(kind=8) ::afmdist
20132 real(kind=8) :: afmdist,Eafmforce
20137 diffafm(i)=c(i,afmend)-c(i,afmbeg)
20138 afmdist=afmdist+diffafm(i)**2
20140 afmdist=dsqrt(afmdist)
20141 ! print *,afmdist,distafminit
20142 Eafmforce=-forceAFMconst*(afmdist-distafminit)
20144 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
20145 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
20147 !C print *,'AFM',Eafmforce
20149 end subroutine AFMforce
20151 !-----------------------------------------------------------------------------
20153 subroutine read_ssHist
20156 ! include 'DIMENSIONS'
20157 ! include "DIMENSIONS.FREE"
20158 ! include 'COMMON.FREE'
20161 character(len=80) :: controlcard
20164 call card_concat(controlcard,.true.)
20165 read(controlcard,*) &
20166 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
20170 end subroutine read_ssHist
20172 !-----------------------------------------------------------------------------
20173 integer function indmat(i,j)
20175 ! get the position of the jth ijth fragment of the chain coordinate system
20176 ! in the fromto array.
20179 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
20181 end function indmat
20182 !-----------------------------------------------------------------------------
20183 real(kind=8) function sigm(x)
20189 !-----------------------------------------------------------------------------
20190 !-----------------------------------------------------------------------------
20191 subroutine alloc_ener_arrays
20192 !EL Allocation of arrays used by module energy
20193 use MD_data, only: mset
20194 !el local variables
20197 if(nres.lt.100) then
20199 elseif(nres.lt.200) then
20200 maxconts=10*nres ! Max. number of contacts per residue
20202 maxconts=10*nres ! (maxconts=maxres/4)
20204 maxcont=12*nres ! Max. number of SC contacts
20205 maxvar=6*nres ! Max. number of variables
20206 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
20207 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
20208 !----------------------
20209 ! arrays in subroutine init_int_table
20211 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
20212 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
20214 allocate(nint_gr(nres))
20215 allocate(nscp_gr(nres))
20216 allocate(ielstart(nres))
20217 allocate(ielend(nres))
20219 allocate(istart(nres,maxint_gr))
20220 allocate(iend(nres,maxint_gr))
20221 !(maxres,maxint_gr)
20222 allocate(iscpstart(nres,maxint_gr))
20223 allocate(iscpend(nres,maxint_gr))
20224 !(maxres,maxint_gr)
20225 allocate(ielstart_vdw(nres))
20226 allocate(ielend_vdw(nres))
20228 allocate(nint_gr_nucl(nres))
20229 allocate(nscp_gr_nucl(nres))
20230 allocate(ielstart_nucl(nres))
20231 allocate(ielend_nucl(nres))
20233 allocate(istart_nucl(nres,maxint_gr))
20234 allocate(iend_nucl(nres,maxint_gr))
20235 !(maxres,maxint_gr)
20236 allocate(iscpstart_nucl(nres,maxint_gr))
20237 allocate(iscpend_nucl(nres,maxint_gr))
20238 !(maxres,maxint_gr)
20239 allocate(ielstart_vdw_nucl(nres))
20240 allocate(ielend_vdw_nucl(nres))
20242 allocate(lentyp(0:nfgtasks-1))
20244 !----------------------
20246 ! common /contacts/
20247 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
20248 allocate(icont(2,maxcont))
20250 ! common /contacts1/
20251 allocate(num_cont(0:nres+4))
20253 allocate(jcont(maxconts,nres))
20255 allocate(facont(maxconts,nres))
20257 allocate(gacont(3,maxconts,nres))
20258 !(3,maxconts,maxres)
20259 ! common /contacts_hb/
20260 allocate(gacontp_hb1(3,maxconts,nres))
20261 allocate(gacontp_hb2(3,maxconts,nres))
20262 allocate(gacontp_hb3(3,maxconts,nres))
20263 allocate(gacontm_hb1(3,maxconts,nres))
20264 allocate(gacontm_hb2(3,maxconts,nres))
20265 allocate(gacontm_hb3(3,maxconts,nres))
20266 allocate(gacont_hbr(3,maxconts,nres))
20267 allocate(grij_hb_cont(3,maxconts,nres))
20268 !(3,maxconts,maxres)
20269 allocate(facont_hb(maxconts,nres))
20271 allocate(ees0p(maxconts,nres))
20272 allocate(ees0m(maxconts,nres))
20273 allocate(d_cont(maxconts,nres))
20274 allocate(ees0plist(maxconts,nres))
20277 allocate(num_cont_hb(nres))
20279 allocate(jcont_hb(maxconts,nres))
20282 allocate(Ug(2,2,nres))
20283 allocate(Ugder(2,2,nres))
20284 allocate(Ug2(2,2,nres))
20285 allocate(Ug2der(2,2,nres))
20287 allocate(obrot(2,nres))
20288 allocate(obrot2(2,nres))
20289 allocate(obrot_der(2,nres))
20290 allocate(obrot2_der(2,nres))
20292 ! common /precomp1/
20293 allocate(mu(2,nres))
20294 allocate(muder(2,nres))
20295 allocate(Ub2(2,nres))
20298 allocate(Ub2der(2,nres))
20299 allocate(Ctobr(2,nres))
20300 allocate(Ctobrder(2,nres))
20301 allocate(Dtobr2(2,nres))
20302 allocate(Dtobr2der(2,nres))
20304 allocate(EUg(2,2,nres))
20305 allocate(EUgder(2,2,nres))
20306 allocate(CUg(2,2,nres))
20307 allocate(CUgder(2,2,nres))
20308 allocate(DUg(2,2,nres))
20309 allocate(Dugder(2,2,nres))
20310 allocate(DtUg2(2,2,nres))
20311 allocate(DtUg2der(2,2,nres))
20313 ! common /precomp2/
20314 allocate(Ug2Db1t(2,nres))
20315 allocate(Ug2Db1tder(2,nres))
20316 allocate(CUgb2(2,nres))
20317 allocate(CUgb2der(2,nres))
20319 allocate(EUgC(2,2,nres))
20320 allocate(EUgCder(2,2,nres))
20321 allocate(EUgD(2,2,nres))
20322 allocate(EUgDder(2,2,nres))
20323 allocate(DtUg2EUg(2,2,nres))
20324 allocate(Ug2DtEUg(2,2,nres))
20326 allocate(Ug2DtEUgder(2,2,2,nres))
20327 allocate(DtUg2EUgder(2,2,2,nres))
20329 allocate(b1(2,nres)) !(2,-maxtor:maxtor)
20330 allocate(b2(2,nres)) !(2,-maxtor:maxtor)
20331 allocate(b1tilde(2,nres)) !(2,-maxtor:maxtor)
20332 allocate(b2tilde(2,nres)) !(2,-maxtor:maxtor)
20334 allocate(ctilde(2,2,nres))
20335 allocate(dtilde(2,2,nres)) !(2,2,-maxtor:maxtor)
20336 allocate(gtb1(2,nres))
20337 allocate(gtb2(2,nres))
20338 allocate(cc(2,2,nres))
20339 allocate(dd(2,2,nres))
20340 allocate(ee(2,2,nres))
20341 allocate(gtcc(2,2,nres))
20342 allocate(gtdd(2,2,nres))
20343 allocate(gtee(2,2,nres))
20344 allocate(gUb2(2,nres))
20345 allocate(gteUg(2,2,nres))
20347 ! common /rotat_old/
20348 allocate(costab(nres))
20349 allocate(sintab(nres))
20350 allocate(costab2(nres))
20351 allocate(sintab2(nres))
20354 allocate(a_chuj(2,2,maxconts,nres))
20355 !(2,2,maxconts,maxres)(maxconts=maxres/4)
20356 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
20357 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
20358 ! common /contdistrib/
20359 allocate(ncont_sent(nres))
20360 allocate(ncont_recv(nres))
20362 allocate(iat_sent(nres))
20364 allocate(iint_sent(4,nres,nres))
20365 allocate(iint_sent_local(4,nres,nres))
20367 allocate(iturn3_sent(4,0:nres+4))
20368 allocate(iturn4_sent(4,0:nres+4))
20369 allocate(iturn3_sent_local(4,nres))
20370 allocate(iturn4_sent_local(4,nres))
20372 allocate(itask_cont_from(0:nfgtasks-1))
20373 allocate(itask_cont_to(0:nfgtasks-1))
20374 !(0:max_fg_procs-1)
20378 !----------------------
20381 allocate(dcdv(6,maxdim))
20382 allocate(dxdv(6,maxdim))
20384 allocate(dxds(6,nres))
20386 allocate(gradx(3,-1:nres,0:2))
20387 allocate(gradc(3,-1:nres,0:2))
20389 allocate(gvdwx(3,-1:nres))
20390 allocate(gvdwc(3,-1:nres))
20391 allocate(gelc(3,-1:nres))
20392 allocate(gelc_long(3,-1:nres))
20393 allocate(gvdwpp(3,-1:nres))
20394 allocate(gvdwc_scpp(3,-1:nres))
20395 allocate(gradx_scp(3,-1:nres))
20396 allocate(gvdwc_scp(3,-1:nres))
20397 allocate(ghpbx(3,-1:nres))
20398 allocate(ghpbc(3,-1:nres))
20399 allocate(gradcorr(3,-1:nres))
20400 allocate(gradcorr_long(3,-1:nres))
20401 allocate(gradcorr5_long(3,-1:nres))
20402 allocate(gradcorr6_long(3,-1:nres))
20403 allocate(gcorr6_turn_long(3,-1:nres))
20404 allocate(gradxorr(3,-1:nres))
20405 allocate(gradcorr5(3,-1:nres))
20406 allocate(gradcorr6(3,-1:nres))
20407 allocate(gliptran(3,-1:nres))
20408 allocate(gliptranc(3,-1:nres))
20409 allocate(gliptranx(3,-1:nres))
20410 allocate(gshieldx(3,-1:nres))
20411 allocate(gshieldc(3,-1:nres))
20412 allocate(gshieldc_loc(3,-1:nres))
20413 allocate(gshieldx_ec(3,-1:nres))
20414 allocate(gshieldc_ec(3,-1:nres))
20415 allocate(gshieldc_loc_ec(3,-1:nres))
20416 allocate(gshieldx_t3(3,-1:nres))
20417 allocate(gshieldc_t3(3,-1:nres))
20418 allocate(gshieldc_loc_t3(3,-1:nres))
20419 allocate(gshieldx_t4(3,-1:nres))
20420 allocate(gshieldc_t4(3,-1:nres))
20421 allocate(gshieldc_loc_t4(3,-1:nres))
20422 allocate(gshieldx_ll(3,-1:nres))
20423 allocate(gshieldc_ll(3,-1:nres))
20424 allocate(gshieldc_loc_ll(3,-1:nres))
20425 allocate(grad_shield(3,-1:nres))
20426 allocate(gg_tube_sc(3,-1:nres))
20427 allocate(gg_tube(3,-1:nres))
20428 allocate(gradafm(3,-1:nres))
20429 allocate(gradb_nucl(3,-1:nres))
20430 allocate(gradbx_nucl(3,-1:nres))
20431 allocate(gvdwpsb1(3,-1:nres))
20432 allocate(gelpp(3,-1:nres))
20433 allocate(gvdwpsb(3,-1:nres))
20434 allocate(gelsbc(3,-1:nres))
20435 allocate(gelsbx(3,-1:nres))
20436 allocate(gvdwsbx(3,-1:nres))
20437 allocate(gvdwsbc(3,-1:nres))
20438 allocate(gsbloc(3,-1:nres))
20439 allocate(gsblocx(3,-1:nres))
20440 allocate(gradcorr_nucl(3,-1:nres))
20441 allocate(gradxorr_nucl(3,-1:nres))
20442 allocate(gradcorr3_nucl(3,-1:nres))
20443 allocate(gradxorr3_nucl(3,-1:nres))
20444 allocate(gvdwpp_nucl(3,-1:nres))
20445 allocate(gradpepcat(3,-1:nres))
20446 allocate(gradpepcatx(3,-1:nres))
20447 allocate(gradcatcat(3,-1:nres))
20448 allocate(gradnuclcat(3,-1:nres))
20449 allocate(gradnuclcatx(3,-1:nres))
20451 allocate(grad_shield_side(3,maxcontsshi,-1:nres))
20452 allocate(grad_shield_loc(3,maxcontsshi,-1:nres))
20453 ! grad for shielding surroing
20454 allocate(gloc(0:maxvar,0:2))
20455 allocate(gloc_x(0:maxvar,2))
20457 allocate(gel_loc(3,-1:nres))
20458 allocate(gel_loc_long(3,-1:nres))
20459 allocate(gcorr3_turn(3,-1:nres))
20460 allocate(gcorr4_turn(3,-1:nres))
20461 allocate(gcorr6_turn(3,-1:nres))
20462 allocate(gradb(3,-1:nres))
20463 allocate(gradbx(3,-1:nres))
20465 allocate(gel_loc_loc(maxvar))
20466 allocate(gel_loc_turn3(maxvar))
20467 allocate(gel_loc_turn4(maxvar))
20468 allocate(gel_loc_turn6(maxvar))
20469 allocate(gcorr_loc(maxvar))
20470 allocate(g_corr5_loc(maxvar))
20471 allocate(g_corr6_loc(maxvar))
20473 allocate(gsccorc(3,-1:nres))
20474 allocate(gsccorx(3,-1:nres))
20476 allocate(gsccor_loc(-1:nres))
20478 allocate(gvdwx_scbase(3,-1:nres))
20479 allocate(gvdwc_scbase(3,-1:nres))
20480 allocate(gvdwx_pepbase(3,-1:nres))
20481 allocate(gvdwc_pepbase(3,-1:nres))
20482 allocate(gvdwx_scpho(3,-1:nres))
20483 allocate(gvdwc_scpho(3,-1:nres))
20484 allocate(gvdwc_peppho(3,-1:nres))
20486 allocate(dtheta(3,2,-1:nres))
20488 allocate(gscloc(3,-1:nres))
20489 allocate(gsclocx(3,-1:nres))
20491 allocate(dphi(3,3,-1:nres))
20492 allocate(dalpha(3,3,-1:nres))
20493 allocate(domega(3,3,-1:nres))
20495 ! common /deriv_scloc/
20496 allocate(dXX_C1tab(3,nres))
20497 allocate(dYY_C1tab(3,nres))
20498 allocate(dZZ_C1tab(3,nres))
20499 allocate(dXX_Ctab(3,nres))
20500 allocate(dYY_Ctab(3,nres))
20501 allocate(dZZ_Ctab(3,nres))
20502 allocate(dXX_XYZtab(3,nres))
20503 allocate(dYY_XYZtab(3,nres))
20504 allocate(dZZ_XYZtab(3,nres))
20507 allocate(jgrad_start(nres))
20508 allocate(jgrad_end(nres))
20510 !----------------------
20513 allocate(ibond_displ(0:nfgtasks-1))
20514 allocate(ibond_count(0:nfgtasks-1))
20515 allocate(ithet_displ(0:nfgtasks-1))
20516 allocate(ithet_count(0:nfgtasks-1))
20517 allocate(iphi_displ(0:nfgtasks-1))
20518 allocate(iphi_count(0:nfgtasks-1))
20519 allocate(iphi1_displ(0:nfgtasks-1))
20520 allocate(iphi1_count(0:nfgtasks-1))
20521 allocate(ivec_displ(0:nfgtasks-1))
20522 allocate(ivec_count(0:nfgtasks-1))
20523 allocate(iset_displ(0:nfgtasks-1))
20524 allocate(iset_count(0:nfgtasks-1))
20525 allocate(iint_count(0:nfgtasks-1))
20526 allocate(iint_displ(0:nfgtasks-1))
20527 !(0:max_fg_procs-1)
20528 !----------------------
20531 allocate(gcart(3,-1:nres))
20532 allocate(gxcart(3,-1:nres))
20534 allocate(gradcag(3,-1:nres))
20535 allocate(gradxag(3,-1:nres))
20537 ! common /back_constr/
20538 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
20539 allocate(dutheta(nres))
20540 allocate(dugamma(nres))
20542 allocate(duscdiff(3,nres))
20543 allocate(duscdiffx(3,nres))
20545 !el i io:read_fragments
20546 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
20547 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
20549 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
20550 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
20551 allocate(mset(0:nprocs)) !(maxprocs/20)
20553 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
20554 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
20555 allocate(dUdconst(3,0:nres))
20556 allocate(dUdxconst(3,0:nres))
20557 allocate(dqwol(3,0:nres))
20558 allocate(dxqwol(3,0:nres))
20560 !----------------------
20562 ! common /sbridge/ in io_common: read_bridge
20563 !el allocate((:),allocatable :: iss !(maxss)
20564 ! common /links/ in io_common: read_bridge
20565 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
20566 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
20567 ! common /dyn_ssbond/
20568 ! and side-chain vectors in theta or phi.
20569 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
20573 dyn_ssbond_ij(:,:)=1.0d300
20577 ! if (nss.gt.0) then
20578 allocate(idssb(maxdim),jdssb(maxdim))
20579 ! allocate(newihpb(nss),newjhpb(nss))
20582 allocate(ishield_list(-1:nres))
20583 allocate(shield_list(maxcontsshi,-1:nres))
20584 allocate(dyn_ss_mask(nres))
20585 allocate(fac_shield(-1:nres))
20586 allocate(enetube(nres*2))
20587 allocate(enecavtube(nres*2))
20590 dyn_ss_mask(:)=.false.
20591 !----------------------
20593 ! Parameters of the SCCOR term
20595 !el in io_conf: parmread
20596 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
20597 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
20598 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
20599 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
20600 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
20601 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
20602 ! allocate(vlor1sccor(maxterm_sccor,20,20))
20603 ! allocate(vlor2sccor(maxterm_sccor,20,20))
20604 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
20606 allocate(gloc_sc(3,0:2*nres,0:10))
20607 !(3,0:maxres2,10)maxres2=2*maxres
20608 allocate(dcostau(3,3,3,2*nres))
20609 allocate(dsintau(3,3,3,2*nres))
20610 allocate(dtauangle(3,3,3,2*nres))
20611 allocate(dcosomicron(3,3,3,2*nres))
20612 allocate(domicron(3,3,3,2*nres))
20613 !(3,3,3,maxres2)maxres2=2*maxres
20614 !----------------------
20617 allocate(varall(maxvar))
20618 !(maxvar)(maxvar=6*maxres)
20619 allocate(mask_theta(nres))
20620 allocate(mask_phi(nres))
20621 allocate(mask_side(nres))
20623 !----------------------
20626 allocate(uy(3,nres))
20627 allocate(uz(3,nres))
20629 allocate(uygrad(3,3,2,nres))
20630 allocate(uzgrad(3,3,2,nres))
20632 ! allocateion of lists JPRDLA
20633 allocate(newcontlistppi(300*nres))
20634 allocate(newcontlistscpi(350*nres))
20635 allocate(newcontlisti(300*nres))
20636 allocate(newcontlistppj(300*nres))
20637 allocate(newcontlistscpj(350*nres))
20638 allocate(newcontlistj(300*nres))
20641 end subroutine alloc_ener_arrays
20642 !-----------------------------------------------------------------
20643 subroutine ebond_nucl(estr_nucl)
20645 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
20648 real(kind=8),dimension(3) :: u,ud
20649 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
20650 real(kind=8) :: estr_nucl,diff
20651 integer :: iti,i,j,k,nbi
20653 !C print *,"I enter ebond"
20655 write (iout,*) "ibondp_start,ibondp_end",&
20656 ibondp_nucl_start,ibondp_nucl_end
20657 do i=ibondp_nucl_start,ibondp_nucl_end
20658 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
20659 itype(i,2).eq.ntyp1_molec(2)) cycle
20660 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
20662 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
20663 ! & *dc(j,i-1)/vbld(i)
20665 ! if (energy_dec) write(iout,*)
20666 ! & "estr1",i,vbld(i),distchainmax,
20667 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
20669 diff = vbld(i)-vbldp0_nucl
20670 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
20671 vbldp0_nucl,diff,AKP_nucl*diff*diff
20672 estr_nucl=estr_nucl+diff*diff
20673 ! print *,estr_nucl
20675 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
20677 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
20679 estr_nucl=0.5d0*AKP_nucl*estr_nucl
20680 ! print *,"partial sum", estr_nucl,AKP_nucl
20683 write (iout,*) "ibondp_start,ibondp_end",&
20684 ibond_nucl_start,ibond_nucl_end
20686 do i=ibond_nucl_start,ibond_nucl_end
20687 !C print *, "I am stuck",i
20689 if (iti.eq.ntyp1_molec(2)) cycle
20690 nbi=nbondterm_nucl(iti)
20693 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
20696 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
20697 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
20698 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
20699 ! print *,estr_nucl
20701 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
20705 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
20706 ud(j)=aksc_nucl(j,iti)*diff
20707 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
20721 uprod2=uprod2*u(k)*u(k)
20725 usumsqder=usumsqder+ud(j)*uprod2
20727 estr_nucl=estr_nucl+uprod/usum
20729 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
20733 !C print *,"I am about to leave ebond"
20735 end subroutine ebond_nucl
20737 !-----------------------------------------------------------------------------
20738 subroutine ebend_nucl(etheta_nucl)
20739 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
20740 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
20741 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
20742 logical :: lprn=.false., lprn1=.false.
20743 !el local variables
20744 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
20745 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
20746 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
20747 ! local variables for constrains
20748 real(kind=8) :: difi,thetiii
20751 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
20752 do i=ithet_nucl_start,ithet_nucl_end
20753 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
20754 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
20755 (itype(i,2).eq.ntyp1_molec(2))) cycle
20759 theti2=0.5d0*theta(i)
20760 ityp2=ithetyp_nucl(itype(i-1,2))
20761 do k=1,nntheterm_nucl
20762 coskt(k)=dcos(k*theti2)
20763 sinkt(k)=dsin(k*theti2)
20765 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
20768 if (phii.ne.phii) phii=150.0
20772 ityp1=ithetyp_nucl(itype(i-2,2))
20773 do k=1,nsingle_nucl
20774 cosph1(k)=dcos(k*phii)
20775 sinph1(k)=dsin(k*phii)
20779 ityp1=nthetyp_nucl+1
20780 do k=1,nsingle_nucl
20786 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
20789 if (phii1.ne.phii1) phii1=150.0
20790 phii1=pinorm(phii1)
20794 ityp3=ithetyp_nucl(itype(i,2))
20795 do k=1,nsingle_nucl
20796 cosph2(k)=dcos(k*phii1)
20797 sinph2(k)=dsin(k*phii1)
20801 ityp3=nthetyp_nucl+1
20802 do k=1,nsingle_nucl
20807 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
20808 do k=1,ndouble_nucl
20810 ccl=cosph1(l)*cosph2(k-l)
20811 ssl=sinph1(l)*sinph2(k-l)
20812 scl=sinph1(l)*cosph2(k-l)
20813 csl=cosph1(l)*sinph2(k-l)
20814 cosph1ph2(l,k)=ccl-ssl
20815 cosph1ph2(k,l)=ccl+ssl
20816 sinph1ph2(l,k)=scl+csl
20817 sinph1ph2(k,l)=scl-csl
20821 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
20822 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
20823 write (iout,*) "coskt and sinkt",nntheterm_nucl
20824 do k=1,nntheterm_nucl
20825 write (iout,*) k,coskt(k),sinkt(k)
20828 do k=1,ntheterm_nucl
20829 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
20830 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
20833 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
20837 write (iout,*) "cosph and sinph"
20838 do k=1,nsingle_nucl
20839 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
20841 write (iout,*) "cosph1ph2 and sinph2ph2"
20842 do k=2,ndouble_nucl
20844 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
20845 sinph1ph2(l,k),sinph1ph2(k,l)
20848 write(iout,*) "ethetai",ethetai
20850 do m=1,ntheterm2_nucl
20851 do k=1,nsingle_nucl
20852 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
20853 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
20854 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
20855 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
20856 ethetai=ethetai+sinkt(m)*aux
20857 dethetai=dethetai+0.5d0*m*aux*coskt(m)
20858 dephii=dephii+k*sinkt(m)*(&
20859 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
20860 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
20861 dephii1=dephii1+k*sinkt(m)*(&
20862 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
20863 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
20865 write (iout,*) "m",m," k",k," bbthet",&
20866 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
20867 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
20868 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
20869 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20873 write(iout,*) "ethetai",ethetai
20874 do m=1,ntheterm3_nucl
20875 do k=2,ndouble_nucl
20877 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20878 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
20879 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20880 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
20881 ethetai=ethetai+sinkt(m)*aux
20882 dethetai=dethetai+0.5d0*m*coskt(m)*aux
20883 dephii=dephii+l*sinkt(m)*(&
20884 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
20885 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20886 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20887 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20888 dephii1=dephii1+(k-l)*sinkt(m)*( &
20889 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20890 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20891 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
20892 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20894 write (iout,*) "m",m," k",k," l",l," ffthet", &
20895 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
20896 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
20897 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
20898 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20899 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
20900 cosph1ph2(k,l)*sinkt(m),&
20901 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
20907 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
20908 i,theta(i)*rad2deg,phii*rad2deg, &
20909 phii1*rad2deg,ethetai
20910 etheta_nucl=etheta_nucl+ethetai
20911 ! print *,i,"partial sum",etheta_nucl
20912 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
20913 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
20914 gloc(nphi+i-2,icg)=wang_nucl*dethetai
20917 end subroutine ebend_nucl
20918 !----------------------------------------------------
20919 subroutine etor_nucl(etors_nucl)
20920 ! implicit real*8 (a-h,o-z)
20921 ! include 'DIMENSIONS'
20922 ! include 'COMMON.VAR'
20923 ! include 'COMMON.GEO'
20924 ! include 'COMMON.LOCAL'
20925 ! include 'COMMON.TORSION'
20926 ! include 'COMMON.INTERACT'
20927 ! include 'COMMON.DERIV'
20928 ! include 'COMMON.CHAIN'
20929 ! include 'COMMON.NAMES'
20930 ! include 'COMMON.IOUNITS'
20931 ! include 'COMMON.FFIELD'
20932 ! include 'COMMON.TORCNSTR'
20933 ! include 'COMMON.CONTROL'
20934 real(kind=8) :: etors_nucl,edihcnstr
20936 !el local variables
20937 integer :: i,j,iblock,itori,itori1
20938 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
20939 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
20940 ! Set lprn=.true. for debugging
20944 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
20945 do i=iphi_nucl_start,iphi_nucl_end
20946 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
20947 .or. itype(i-3,2).eq.ntyp1_molec(2) &
20948 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
20950 itori=itortyp_nucl(itype(i-2,2))
20951 itori1=itortyp_nucl(itype(i-1,2))
20953 ! print *,i,itori,itori1
20955 !C Regular cosine and sine terms
20956 do j=1,nterm_nucl(itori,itori1)
20957 v1ij=v1_nucl(j,itori,itori1)
20958 v2ij=v2_nucl(j,itori,itori1)
20959 cosphi=dcos(j*phii)
20960 sinphi=dsin(j*phii)
20961 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
20962 if (energy_dec) etors_ii=etors_ii+&
20963 v1ij*cosphi+v2ij*sinphi
20964 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
20968 !C E = SUM ----------------------------------- - v1
20969 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
20971 cosphi=dcos(0.5d0*phii)
20972 sinphi=dsin(0.5d0*phii)
20973 do j=1,nlor_nucl(itori,itori1)
20974 vl1ij=vlor1_nucl(j,itori,itori1)
20975 vl2ij=vlor2_nucl(j,itori,itori1)
20976 vl3ij=vlor3_nucl(j,itori,itori1)
20977 pom=vl2ij*cosphi+vl3ij*sinphi
20978 pom1=1.0d0/(pom*pom+1.0d0)
20979 etors_nucl=etors_nucl+vl1ij*pom1
20980 if (energy_dec) etors_ii=etors_ii+ &
20983 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
20985 !C Subtract the constant term
20986 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
20987 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
20988 'etor',i,etors_ii-v0_nucl(itori,itori1)
20990 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
20991 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
20992 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
20993 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
20994 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
20997 end subroutine etor_nucl
20998 !------------------------------------------------------------
20999 subroutine epp_nucl_sub(evdw1,ees)
21001 !C This subroutine calculates the average interaction energy and its gradient
21002 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
21003 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
21004 !C The potential depends both on the distance of peptide-group centers and on
21005 !C the orientation of the CA-CA virtual bonds.
21007 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
21008 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbbi,sslipi,ssgradlipi, &
21009 sslipj,ssgradlipj,faclipij2
21010 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
21011 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
21012 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
21013 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21014 dist_temp, dist_init,sss_grad,fac,evdw1ij
21015 integer xshift,yshift,zshift
21016 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
21017 real(kind=8) :: ees,eesij
21018 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
21019 real(kind=8) scal_el /0.5d0/
21025 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
21027 ! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
21028 do i=iatel_s_nucl,iatel_e_nucl
21029 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
21033 dx_normi=dc_norm(1,i)
21034 dy_normi=dc_norm(2,i)
21035 dz_normi=dc_norm(3,i)
21036 xmedi=c(1,i)+0.5d0*dxi
21037 ymedi=c(2,i)+0.5d0*dyi
21038 zmedi=c(3,i)+0.5d0*dzi
21039 call to_box(xmedi,ymedi,zmedi)
21040 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
21042 do j=ielstart_nucl(i),ielend_nucl(i)
21043 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
21048 ! xj=c(1,j)+0.5D0*dxj-xmedi
21049 ! yj=c(2,j)+0.5D0*dyj-ymedi
21050 ! zj=c(3,j)+0.5D0*dzj-zmedi
21051 xj=c(1,j)+0.5D0*dxj
21052 yj=c(2,j)+0.5D0*dyj
21053 zj=c(3,j)+0.5D0*dzj
21054 call to_box(xj,yj,zj)
21055 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
21056 faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
21057 xj=boxshift(xj-xmedi,boxxsize)
21058 yj=boxshift(yj-ymedi,boxysize)
21059 zj=boxshift(zj-zmedi,boxzsize)
21060 rij=xj*xj+yj*yj+zj*zj
21061 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
21062 fac=(r0pp**2/rij)**3
21066 fac=(-ev1-evdw1ij)/rij
21067 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
21068 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
21069 evdw1=evdw1+evdw1ij
21071 !C Calculate contributions to the Cartesian gradient.
21077 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
21078 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
21080 !c phoshate-phosphate electrostatic interactions
21083 eesij=dexp(-BEES*rij)*fac
21084 ! write (2,*)"fac",fac," eesijpp",eesij
21085 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
21088 fac=-(fac+BEES)*eesij*fac
21092 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
21093 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
21094 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
21096 gelpp(k,i)=gelpp(k,i)-ggg(k)
21097 gelpp(k,j)=gelpp(k,j)+ggg(k)
21104 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
21106 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
21107 !c gelpp(k,i)=332.0d0*gelpp(k,i)
21108 gelpp(k,i)=AEES*gelpp(k,i)
21110 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
21112 !c write (2,*) "total EES",ees
21114 end subroutine epp_nucl_sub
21115 !---------------------------------------------------------------------
21116 subroutine epsb(evdwpsb,eelpsb)
21119 !C This subroutine calculates the excluded-volume interaction energy between
21120 !C peptide-group centers and side chains and its gradient in virtual-bond and
21121 !C side-chain vectors.
21123 real(kind=8),dimension(3):: ggg
21124 integer :: i,iint,j,k,iteli,itypj,subchap
21125 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
21126 e1,e2,evdwij,rij,evdwpsb,eelpsb
21127 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21128 dist_temp, dist_init
21129 integer xshift,yshift,zshift
21131 !cd print '(a)','Enter ESCP'
21132 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
21135 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
21136 do i=iatscp_s_nucl,iatscp_e_nucl
21137 if (itype(i,2).eq.ntyp1_molec(2) &
21138 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
21139 xi=0.5D0*(c(1,i)+c(1,i+1))
21140 yi=0.5D0*(c(2,i)+c(2,i+1))
21141 zi=0.5D0*(c(3,i)+c(3,i+1))
21142 call to_box(xi,yi,zi)
21144 do iint=1,nscp_gr_nucl(i)
21146 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
21148 if (itypj.eq.ntyp1_molec(2)) cycle
21149 !C Uncomment following three lines for SC-p interactions
21150 !c xj=c(1,nres+j)-xi
21151 !c yj=c(2,nres+j)-yi
21152 !c zj=c(3,nres+j)-zi
21153 !C Uncomment following three lines for Ca-p interactions
21160 call to_box(xj,yj,zj)
21161 xj=boxshift(xj-xi,boxxsize)
21162 yj=boxshift(yj-yi,boxysize)
21163 zj=boxshift(zj-zi,boxzsize)
21165 dist_init=xj**2+yj**2+zj**2
21167 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
21169 e1=fac*fac*aad_nucl(itypj)
21170 e2=fac*bad_nucl(itypj)
21171 if (iabs(j-i) .le. 2) then
21176 evdwpsb=evdwpsb+evdwij
21177 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
21178 'evdw2',i,j,evdwij,"tu4"
21180 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
21182 fac=-(evdwij+e1)*rrij
21187 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
21188 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
21196 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
21197 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
21201 end subroutine epsb
21203 !------------------------------------------------------
21204 subroutine esb_gb(evdwsb,eelsb)
21207 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
21208 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
21209 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
21210 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21211 dist_temp, dist_init,aa,bb,faclip,sig0ij
21220 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
21221 do i=iatsc_s_nucl,iatsc_e_nucl
21225 ! PRINT *,"I=",i,itypi
21226 if (itypi.eq.ntyp1_molec(2)) cycle
21227 itypi1=itype(i+1,2)
21231 call to_box(xi,yi,zi)
21232 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
21233 dxi=dc_norm(1,nres+i)
21234 dyi=dc_norm(2,nres+i)
21235 dzi=dc_norm(3,nres+i)
21236 dsci_inv=vbld_inv(i+nres)
21238 !C Calculate SC interaction energy.
21240 do iint=1,nint_gr_nucl(i)
21241 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
21242 do j=istart_nucl(i,iint),iend_nucl(i,iint)
21246 if (itypj.eq.ntyp1_molec(2)) cycle
21247 dscj_inv=vbld_inv(j+nres)
21248 sig0ij=sigma_nucl(itypi,itypj)
21249 chi1=chi_nucl(itypi,itypj)
21250 chi2=chi_nucl(itypj,itypi)
21252 chip1=chip_nucl(itypi,itypj)
21253 chip2=chip_nucl(itypj,itypi)
21255 ! xj=c(1,nres+j)-xi
21256 ! yj=c(2,nres+j)-yi
21257 ! zj=c(3,nres+j)-zi
21261 call to_box(xj,yj,zj)
21262 ! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
21263 ! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
21264 ! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
21265 ! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
21266 ! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
21267 xj=boxshift(xj-xi,boxxsize)
21268 yj=boxshift(yj-yi,boxysize)
21269 zj=boxshift(zj-zi,boxzsize)
21271 dxj=dc_norm(1,nres+j)
21272 dyj=dc_norm(2,nres+j)
21273 dzj=dc_norm(3,nres+j)
21274 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
21276 !C Calculate angle-dependent terms of energy and contributions to their
21281 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
21282 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
21283 om12=dxi*dxj+dyi*dyj+dzi*dzj
21284 call sc_angular_nucl
21286 sig=sig0ij*dsqrt(sigsq)
21287 rij_shift=1.0D0/rij-sig+sig0ij
21288 ! print *,rij_shift,"rij_shift"
21289 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
21290 !c & " rij_shift",rij_shift
21291 if (rij_shift.le.0.0D0) then
21296 !c---------------------------------------------------------------
21297 rij_shift=1.0D0/rij_shift
21298 fac=rij_shift**expon
21299 e1=fac*fac*aa_nucl(itypi,itypj)
21300 e2=fac*bb_nucl(itypi,itypj)
21301 evdwij=eps1*eps2rt*(e1+e2)
21302 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
21303 !c & " e1",e1," e2",e2," evdwij",evdwij
21305 evdwij=evdwij*eps2rt
21306 evdwsb=evdwsb+evdwij
21308 sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
21309 epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
21310 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
21311 restyp(itypi,2),i,restyp(itypj,2),j, &
21312 epsi,sigm,chi1,chi2,chip1,chip2, &
21313 eps1,eps2rt**2,sig,sig0ij, &
21314 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
21316 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
21319 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
21320 'evdw',i,j,evdwij,"tu3"
21323 !C Calculate gradient components.
21324 e1=e1*eps1*eps2rt**2
21325 fac=-expon*(e1+evdwij)*rij_shift
21329 !C Calculate the radial part of the gradient
21333 !C Calculate angular part of the gradient.
21335 call eelsbij(eelij,num_conti2)
21336 if (energy_dec .and. &
21337 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
21338 write (istat,'(e14.5)') evdwij
21342 num_cont_hb(i)=num_conti2
21344 !c write (iout,*) "Number of loop steps in EGB:",ind
21345 !cccc energy_dec=.false.
21347 end subroutine esb_gb
21348 !-------------------------------------------------------------------------------
21349 subroutine eelsbij(eesij,num_conti2)
21352 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
21353 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
21354 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21355 dist_temp, dist_init,rlocshield,fracinbuf
21356 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
21358 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
21359 real(kind=8) scal_el /0.5d0/
21360 integer :: iteli,itelj,kkk,kkll,m,isubchap
21361 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
21362 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
21363 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
21364 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
21365 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
21366 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
21367 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
21368 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
21369 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
21370 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
21374 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
21375 ael6i=ael6_nucl(itypi,itypj)
21376 ael3i=ael3_nucl(itypi,itypj)
21377 ael63i=ael63_nucl(itypi,itypj)
21378 ael32i=ael32_nucl(itypi,itypj)
21379 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
21380 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
21384 dx_normi=dc_norm(1,i+nres)
21385 dy_normi=dc_norm(2,i+nres)
21386 dz_normi=dc_norm(3,i+nres)
21387 dx_normj=dc_norm(1,j+nres)
21388 dy_normj=dc_norm(2,j+nres)
21389 dz_normj=dc_norm(3,j+nres)
21390 !c xj=c(1,j)+0.5D0*dxj-xmedi
21391 !c yj=c(2,j)+0.5D0*dyj-ymedi
21392 !c zj=c(3,j)+0.5D0*dzj-zmedi
21393 if (ipot_nucl.ne.2) then
21394 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
21395 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
21396 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
21404 fac=cosa-3.0D0*cosb*cosg
21406 fac1=3.0d0*(cosb*cosb+cosg*cosg)
21411 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
21412 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
21413 el1=fac3*(4.0D0+facfac-fac1)
21415 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
21417 eesij=el1+el2+el3+el4
21418 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
21419 ees0ij=4.0D0+facfac-fac1
21421 if (energy_dec) then
21422 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
21423 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
21424 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
21425 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
21426 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
21427 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
21431 !C Calculate contributions to the Cartesian gradient.
21433 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
21439 !* Radial derivatives. First process both termini of the fragment (i,j)
21445 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
21446 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
21447 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
21448 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
21453 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
21458 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
21460 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
21463 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
21464 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
21467 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
21470 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
21471 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
21472 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21473 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
21474 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21475 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21476 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
21477 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
21479 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
21480 IF ( j.gt.i+1 .and.&
21481 num_conti.le.maxcont) THEN
21483 !C Calculate the contact function. The ith column of the array JCONT will
21484 !C contain the numbers of atoms that make contacts with the atom I (of numbers
21485 !C greater than I). The arrays FACONT and GACONT will contain the values of
21486 !C the contact function and its derivative.
21487 r0ij=2.20D0*sigma_nucl(itypi,itypj)
21488 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
21489 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
21490 !c write (2,*) "fcont",fcont
21491 if (fcont.gt.0.0D0) then
21492 num_conti=num_conti+1
21493 num_conti2=num_conti2+1
21495 if (num_conti.gt.maxconts) then
21496 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
21497 ' will skip next contacts for this conf.',maxconts
21499 jcont_hb(num_conti,i)=j
21500 !c write (iout,*) "num_conti",num_conti,
21501 !c & " jcont_hb",jcont_hb(num_conti,i)
21502 !C Calculate contact energies
21504 wij=cosa-3.0D0*cosb*cosg
21507 fac3=dsqrt(-ael6i)*r3ij
21508 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
21509 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
21510 if (ees0tmp.gt.0) then
21511 ees0pij=dsqrt(ees0tmp)
21515 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
21516 if (ees0tmp.gt.0) then
21517 ees0mij=dsqrt(ees0tmp)
21521 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
21522 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
21523 !c write (iout,*) "i",i," j",j,
21524 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
21525 ees0pij1=fac3/ees0pij
21526 ees0mij1=fac3/ees0mij
21527 fac3p=-3.0D0*fac3*rrij
21528 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
21529 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
21530 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
21531 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
21532 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
21533 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
21534 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
21535 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
21536 ecosap=ecosa1+ecosa2
21537 ecosbp=ecosb1+ecosb2
21538 ecosgp=ecosg1+ecosg2
21539 ecosam=ecosa1-ecosa2
21540 ecosbm=ecosb1-ecosb2
21541 ecosgm=ecosg1-ecosg2
21543 facont_hb(num_conti,i)=fcont
21544 fprimcont=fprimcont/rij
21546 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
21547 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
21549 gggp(1)=gggp(1)+ees0pijp*xj
21550 gggp(2)=gggp(2)+ees0pijp*yj
21551 gggp(3)=gggp(3)+ees0pijp*zj
21552 gggm(1)=gggm(1)+ees0mijp*xj
21553 gggm(2)=gggm(2)+ees0mijp*yj
21554 gggm(3)=gggm(3)+ees0mijp*zj
21555 !C Derivatives due to the contact function
21556 gacont_hbr(1,num_conti,i)=fprimcont*xj
21557 gacont_hbr(2,num_conti,i)=fprimcont*yj
21558 gacont_hbr(3,num_conti,i)=fprimcont*zj
21561 !c Gradient of the correlation terms
21563 gacontp_hb1(k,num_conti,i)= &
21564 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21565 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21566 gacontp_hb2(k,num_conti,i)= &
21567 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
21568 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21569 gacontp_hb3(k,num_conti,i)=gggp(k)
21570 gacontm_hb1(k,num_conti,i)= &
21571 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21572 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21573 gacontm_hb2(k,num_conti,i)= &
21574 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21575 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21576 gacontm_hb3(k,num_conti,i)=gggm(k)
21582 end subroutine eelsbij
21583 !------------------------------------------------------------------
21584 subroutine sc_grad_nucl
21587 real(kind=8),dimension(3) :: dcosom1,dcosom2
21588 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
21589 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
21590 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
21592 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
21593 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
21596 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
21599 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
21600 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
21601 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
21602 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
21603 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
21604 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
21607 !C Calculate the components of the gradient in DC and X
21610 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
21611 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
21614 end subroutine sc_grad_nucl
21615 !-----------------------------------------------------------------------
21616 subroutine esb(esbloc)
21617 !C Calculate the local energy of a side chain and its derivatives in the
21618 !C corresponding virtual-bond valence angles THETA and the spherical angles
21619 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
21620 !C added by Urszula Kozlowska. 07/11/2007
21622 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
21623 real(kind=8),dimension(9):: x
21624 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
21625 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
21626 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
21627 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
21628 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
21629 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
21630 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
21631 integer::it,nlobit,i,j,k
21632 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
21635 do i=loc_start_nucl,loc_end_nucl
21636 if (itype(i,2).eq.ntyp1_molec(2)) cycle
21637 costtab(i+1) =dcos(theta(i+1))
21638 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
21639 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
21640 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
21641 cosfac2=0.5d0/(1.0d0+costtab(i+1))
21642 cosfac=dsqrt(cosfac2)
21643 sinfac2=0.5d0/(1.0d0-costtab(i+1))
21644 sinfac=dsqrt(sinfac2)
21646 if (it.eq.10) goto 1
21649 !C Compute the axes of tghe local cartesian coordinates system; store in
21650 !c x_prime, y_prime and z_prime
21657 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
21658 !C & dc_norm(3,i+nres)
21660 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
21661 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
21664 z_prime(j) = -uz(j,i-1)
21672 xx = xx + x_prime(j)*dc_norm(j,i+nres)
21673 yy = yy + y_prime(j)*dc_norm(j,i+nres)
21674 zz = zz + z_prime(j)*dc_norm(j,i+nres)
21682 x(j) = sc_parmin_nucl(j,it)
21685 !Cc diagnostics - remove later
21686 xx1 = dcos(alph(2))
21687 yy1 = dsin(alph(2))*dcos(omeg(2))
21688 zz1 = -dsin(alph(2))*dsin(omeg(2))
21689 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
21690 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
21692 !C," --- ", xx_w,yy_w,zz_w
21695 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21696 esbloc = esbloc + sumene
21697 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
21698 ! print *,"enecomp",sumene,sumene2
21699 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
21700 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
21702 write (2,*) "x",(x(k),k=1,9)
21704 !C This section to check the numerical derivatives of the energy of ith side
21705 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
21706 !C #define DEBUG in the code to turn it on.
21708 write (2,*) "sumene =",sumene
21712 write (2,*) xx,yy,zz
21713 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21714 de_dxx_num=(sumenep-sumene)/aincr
21716 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
21719 write (2,*) xx,yy,zz
21720 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21721 de_dyy_num=(sumenep-sumene)/aincr
21723 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
21726 write (2,*) xx,yy,zz
21727 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21728 de_dzz_num=(sumenep-sumene)/aincr
21730 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
21731 costsave=cost2tab(i+1)
21732 sintsave=sint2tab(i+1)
21733 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
21734 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
21735 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21736 de_dt_num=(sumenep-sumene)/aincr
21737 write (2,*) " t+ sumene from enesc=",sumenep,sumene
21738 cost2tab(i+1)=costsave
21739 sint2tab(i+1)=sintsave
21740 !C End of diagnostics section.
21743 !C Compute the gradient of esc
21745 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
21746 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
21747 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
21750 write (2,*) "x",(x(k),k=1,9)
21751 write (2,*) "xx",xx," yy",yy," zz",zz
21752 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
21753 " de_zz ",de_zz," de_tt ",de_tt
21754 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
21755 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
21758 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
21759 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
21760 cosfac2xx=cosfac2*xx
21761 sinfac2yy=sinfac2*yy
21763 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
21765 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
21767 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
21768 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
21769 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
21770 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
21771 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
21772 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
21773 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
21774 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
21775 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
21776 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
21780 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
21781 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
21784 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
21785 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
21786 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
21788 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
21789 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
21793 dXX_Ctab(k,i)=dXX_Ci(k)
21794 dXX_C1tab(k,i)=dXX_Ci1(k)
21795 dYY_Ctab(k,i)=dYY_Ci(k)
21796 dYY_C1tab(k,i)=dYY_Ci1(k)
21797 dZZ_Ctab(k,i)=dZZ_Ci(k)
21798 dZZ_C1tab(k,i)=dZZ_Ci1(k)
21799 dXX_XYZtab(k,i)=dXX_XYZ(k)
21800 dYY_XYZtab(k,i)=dYY_XYZ(k)
21801 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
21804 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
21805 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
21806 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
21807 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
21808 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
21810 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
21811 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
21812 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
21813 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
21814 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
21815 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
21816 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
21817 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
21818 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
21820 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
21821 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
21823 !C to check gradient call subroutine check_grad
21829 !=-------------------------------------------------------
21830 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
21832 real(kind=8),dimension(9):: x(9)
21833 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
21834 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
21836 !c write (2,*) "enesc"
21837 !c write (2,*) "x",(x(i),i=1,9)
21838 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
21839 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
21840 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
21844 end function enesc_nucl
21845 !-----------------------------------------------------------------------------
21846 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
21849 integer,parameter :: max_cont=2000
21850 integer,parameter:: max_dim=2*(8*3+6)
21851 integer, parameter :: msglen1=max_cont*max_dim
21852 integer,parameter :: msglen2=2*msglen1
21853 integer source,CorrelType,CorrelID,Error
21854 real(kind=8) :: buffer(max_cont,max_dim)
21855 integer status(MPI_STATUS_SIZE)
21856 integer :: ierror,nbytes
21858 real(kind=8),dimension(3):: gx(3),gx1(3)
21859 real(kind=8) :: time00
21861 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
21862 real(kind=8) ecorr,ecorr3
21863 integer :: n_corr,n_corr1,mm,msglen
21864 !C Set lprn=.true. for debugging
21869 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
21871 if (nfgtasks.le.1) goto 30
21873 write (iout,'(a)') 'Contact function values:'
21875 write (iout,'(2i3,50(1x,i2,f5.2))') &
21876 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21877 j=1,num_cont_hb(i))
21880 !C Caution! Following code assumes that electrostatic interactions concerning
21881 !C a given atom are split among at most two processors!
21891 !c write (*,*) 'MyRank',MyRank,' mm',mm
21894 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
21895 if (fg_rank.gt.0) then
21896 !C Send correlation contributions to the preceding processor
21898 nn=num_cont_hb(iatel_s_nucl)
21899 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
21900 !c write (*,*) 'The BUFFER array:'
21902 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
21904 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
21906 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
21907 !C Clear the contacts of the atom passed to the neighboring processor
21908 nn=num_cont_hb(iatel_s_nucl+1)
21910 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
21912 num_cont_hb(iatel_s_nucl)=0
21914 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
21915 !cd & ' is sending correlation contribution to processor',fg_rank-1,
21916 !cd & ' msglen=',msglen
21917 !c write (*,*) 'Processor ',fg_rank,MyRank,
21918 !c & ' is sending correlation contribution to processor',fg_rank-1,
21919 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21921 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
21922 CorrelType,FG_COMM,IERROR)
21923 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21924 !cd write (iout,*) 'Processor ',fg_rank,
21925 !cd & ' has sent correlation contribution to processor',fg_rank-1,
21926 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
21927 !c write (*,*) 'Processor ',fg_rank,
21928 !c & ' has sent correlation contribution to processor',fg_rank-1,
21929 !c & ' msglen=',msglen,' CorrelID=',CorrelID
21931 endif ! (fg_rank.gt.0)
21935 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
21936 if (fg_rank.lt.nfgtasks-1) then
21937 !C Receive correlation contributions from the next processor
21939 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
21940 !cd write (iout,*) 'Processor',fg_rank,
21941 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
21942 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
21943 !c write (*,*) 'Processor',fg_rank,
21944 !c &' is receiving correlation contribution from processor',fg_rank+1,
21945 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21948 do while (nbytes.le.0)
21949 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21950 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
21952 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
21953 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
21954 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21955 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21956 !c write (*,*) 'Processor',fg_rank,
21957 !c &' has received correlation contribution from processor',fg_rank+1,
21958 !c & ' msglen=',msglen,' nbytes=',nbytes
21959 !c write (*,*) 'The received BUFFER array:'
21961 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
21963 if (msglen.eq.msglen1) then
21964 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
21965 else if (msglen.eq.msglen2) then
21966 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
21967 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
21970 'ERROR!!!! message length changed while processing correlations.'
21972 'ERROR!!!! message length changed while processing correlations.'
21973 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
21974 endif ! msglen.eq.msglen1
21975 endif ! fg_rank.lt.nfgtasks-1
21982 write (iout,'(a)') 'Contact function values:'
21983 do i=nnt_molec(2),nct_molec(2)-1
21984 write (iout,'(2i3,50(1x,i2,f5.2))') &
21985 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21986 j=1,num_cont_hb(i))
21991 !C Remove the loop below after debugging !!!
21992 ! do i=nnt_molec(2),nct_molec(2)
21994 ! gradcorr_nucl(j,i)=0.0D0
21995 ! gradxorr_nucl(j,i)=0.0D0
21996 ! gradcorr3_nucl(j,i)=0.0D0
21997 ! gradxorr3_nucl(j,i)=0.0D0
22000 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
22001 !C Calculate the local-electrostatic correlation terms
22002 do i=iatsc_s_nucl,iatsc_e_nucl
22004 num_conti=num_cont_hb(i)
22005 num_conti1=num_cont_hb(i+1)
22006 ! print *,i,num_conti,num_conti1
22011 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
22012 !c & ' jj=',jj,' kk=',kk
22013 if (j1.eq.j+1 .or. j1.eq.j-1) then
22015 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
22016 !C The system gains extra energy.
22017 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
22018 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
22019 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
22021 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
22022 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
22023 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
22025 else if (j1.eq.j) then
22027 !C Contacts I-J and I-(J+1) occur simultaneously.
22028 !C The system loses extra energy.
22029 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
22030 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
22031 !C Need to implement full formulas 32 from Liwo et al., 1998.
22033 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
22034 !c & ' jj=',jj,' kk=',kk
22035 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
22040 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
22041 !c & ' jj=',jj,' kk=',kk
22042 if (j1.eq.j+1) then
22043 !C Contacts I-J and (I+1)-J occur simultaneously.
22044 !C The system loses extra energy.
22045 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
22051 end subroutine multibody_hb_nucl
22052 !-----------------------------------------------------------
22053 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
22054 ! implicit real*8 (a-h,o-z)
22055 ! include 'DIMENSIONS'
22056 ! include 'COMMON.IOUNITS'
22057 ! include 'COMMON.DERIV'
22058 ! include 'COMMON.INTERACT'
22059 ! include 'COMMON.CONTACTS'
22060 real(kind=8),dimension(3) :: gx,gx1
22062 !el local variables
22063 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
22064 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
22065 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
22066 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
22070 eij=facont_hb(jj,i)
22071 ekl=facont_hb(kk,k)
22072 ees0pij=ees0p(jj,i)
22073 ees0pkl=ees0p(kk,k)
22074 ees0mij=ees0m(jj,i)
22075 ees0mkl=ees0m(kk,k)
22077 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
22078 ! print *,"ehbcorr_nucl",ekont,ees
22079 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
22080 !C Following 4 lines for diagnostics.
22085 !cd write (iout,*)'Contacts have occurred for nucleic bases',
22086 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
22087 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
22088 !C Calculate the multi-body contribution to energy.
22089 ! ecorr_nucl=ecorr_nucl+ekont*ees
22090 !C Calculate multi-body contributions to the gradient.
22091 coeffpees0pij=coeffp*ees0pij
22092 coeffmees0mij=coeffm*ees0mij
22093 coeffpees0pkl=coeffp*ees0pkl
22094 coeffmees0mkl=coeffm*ees0mkl
22096 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
22097 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
22098 coeffmees0mkl*gacontm_hb1(ll,jj,i))
22099 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
22100 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
22101 coeffmees0mkl*gacontm_hb2(ll,jj,i))
22102 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
22103 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
22104 coeffmees0mij*gacontm_hb1(ll,kk,k))
22105 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
22106 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
22107 coeffmees0mij*gacontm_hb2(ll,kk,k))
22108 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
22109 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
22110 coeffmees0mkl*gacontm_hb3(ll,jj,i))
22111 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
22112 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
22113 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
22114 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
22115 coeffmees0mij*gacontm_hb3(ll,kk,k))
22116 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
22117 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
22118 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
22119 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
22120 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
22121 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
22123 ehbcorr_nucl=ekont*ees
22125 end function ehbcorr_nucl
22126 !-------------------------------------------------------------------------
22128 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
22129 ! implicit real*8 (a-h,o-z)
22130 ! include 'DIMENSIONS'
22131 ! include 'COMMON.IOUNITS'
22132 ! include 'COMMON.DERIV'
22133 ! include 'COMMON.INTERACT'
22134 ! include 'COMMON.CONTACTS'
22135 real(kind=8),dimension(3) :: gx,gx1
22137 !el local variables
22138 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
22139 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
22140 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
22141 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
22145 eij=facont_hb(jj,i)
22146 ekl=facont_hb(kk,k)
22147 ees0pij=ees0p(jj,i)
22148 ees0pkl=ees0p(kk,k)
22149 ees0mij=ees0m(jj,i)
22150 ees0mkl=ees0m(kk,k)
22152 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
22153 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
22154 !C Following 4 lines for diagnostics.
22159 !cd write (iout,*)'Contacts have occurred for nucleic bases',
22160 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
22161 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
22162 !C Calculate the multi-body contribution to energy.
22163 ! ecorr=ecorr+ekont*ees
22164 !C Calculate multi-body contributions to the gradient.
22165 coeffpees0pij=coeffp*ees0pij
22166 coeffmees0mij=coeffm*ees0mij
22167 coeffpees0pkl=coeffp*ees0pkl
22168 coeffmees0mkl=coeffm*ees0mkl
22170 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
22171 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
22172 coeffmees0mkl*gacontm_hb1(ll,jj,i))
22173 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
22174 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
22175 coeffmees0mkl*gacontm_hb2(ll,jj,i))
22176 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
22177 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
22178 coeffmees0mij*gacontm_hb1(ll,kk,k))
22179 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
22180 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
22181 coeffmees0mij*gacontm_hb2(ll,kk,k))
22182 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
22183 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
22184 coeffmees0mkl*gacontm_hb3(ll,jj,i))
22185 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
22186 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
22187 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
22188 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
22189 coeffmees0mij*gacontm_hb3(ll,kk,k))
22190 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
22191 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
22192 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
22193 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
22194 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
22195 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
22197 ehbcorr3_nucl=ekont*ees
22199 end function ehbcorr3_nucl
22201 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
22202 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
22203 real(kind=8):: buffer(dimen1,dimen2)
22204 num_kont=num_cont_hb(atom)
22208 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
22211 buffer(i,indx+25)=facont_hb(i,atom)
22212 buffer(i,indx+26)=ees0p(i,atom)
22213 buffer(i,indx+27)=ees0m(i,atom)
22214 buffer(i,indx+28)=d_cont(i,atom)
22215 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
22217 buffer(1,indx+30)=dfloat(num_kont)
22219 end subroutine pack_buffer
22220 !c------------------------------------------------------------------------------
22221 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
22222 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
22223 real(kind=8):: buffer(dimen1,dimen2)
22224 ! double precision zapas
22225 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
22226 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
22227 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
22228 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
22229 num_kont=buffer(1,indx+30)
22230 num_kont_old=num_cont_hb(atom)
22231 num_cont_hb(atom)=num_kont+num_kont_old
22236 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
22239 facont_hb(ii,atom)=buffer(i,indx+25)
22240 ees0p(ii,atom)=buffer(i,indx+26)
22241 ees0m(ii,atom)=buffer(i,indx+27)
22242 d_cont(i,atom)=buffer(i,indx+28)
22243 jcont_hb(ii,atom)=buffer(i,indx+29)
22246 end subroutine unpack_buffer
22247 !c------------------------------------------------------------------------------
22249 subroutine ecatcat(ecationcation)
22250 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,itypi,itypj
22251 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
22252 r7,r4,ecationcation,k0,rcal,aa,bb,sslipi,ssgradlipi,sslipj,ssgradlipj
22253 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
22254 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
22255 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
22258 ecationcation=0.0d0
22259 if (nres_molec(5).eq.0) return
22264 ! k0 = 332.0*(2.0*2.0)/80.0
22268 itmp=itmp+nres_molec(i)
22270 ! write(iout,*) "itmp",itmp
22271 do i=itmp+1,itmp+nres_molec(5)-1
22276 ! write (iout,*) i,"TUTUT",c(1,i)
22278 call to_box(xi,yi,zi)
22279 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
22280 do j=i+1,itmp+nres_molec(5)
22282 ! print *,i,j,itypi,itypj
22283 k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0
22284 ! print *,i,j,'catcat'
22288 call to_box(xj,yj,zj)
22289 ! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
22290 ! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
22291 ! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
22292 ! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
22293 ! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
22294 xj=boxshift(xj-xi,boxxsize)
22295 yj=boxshift(yj-yi,boxysize)
22296 zj=boxshift(zj-zi,boxzsize)
22297 rcal =xj**2+yj**2+zj**2
22303 ! k0 = 332*(2*2)/80
22304 Evan1cat=epscalc*(r012/(rcal**6))
22305 Evan2cat=epscalc*2*(r06/(rcal**3))
22313 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
22314 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
22315 dEeleccat(k)=-k0*r(k)/ract**3
22318 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
22319 gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
22320 gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
22322 if (energy_dec) write (iout,*) i,j,Evan1cat,Evan2cat,Eeleccat,&
22323 r012,rcal**6,ichargecat(itypi)*ichargecat(itypj)
22324 ! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
22325 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
22329 end subroutine ecatcat
22330 !---------------------------------------------------------------------------
22332 subroutine ecats_prot_amber(evdw)
22333 ! subroutine ecat_prot2(ecation_prot)
22338 !el local variables
22339 integer :: iint,itypi1,subchap,isel,itmp
22340 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
22341 real(kind=8) :: evdw,aa,bb
22342 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22343 dist_temp, dist_init,ssgradlipi,ssgradlipj, &
22344 sslipi,sslipj,faclip,alpha_sco
22346 real(kind=8) :: fracinbuf
22347 real (kind=8) :: escpho
22348 real (kind=8),dimension(4):: ener
22349 real(kind=8) :: b1,b2,egb
22350 real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
22352 Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
22353 ecations_prot_amber,dFdOM2,dFdL,dFdOM12,&
22356 ! real(kind=8),dimension(3,2)::erhead_tail
22357 ! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
22358 real(kind=8) :: facd4, adler, Fgb, facd3
22359 integer troll,jj,istate
22360 real (kind=8) :: dcosom1(3),dcosom2(3)
22361 real(kind=8) ::locbox(3)
22367 if (nres_molec(5).eq.0) return
22369 ! sss_ele_cut=1.0d0
22373 itmp=itmp+nres_molec(i)
22376 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
22377 do i=ibond_start,ibond_end
22379 ! print *,"I am in EVDW",i
22380 itypi=iabs(itype(i,1))
22382 ! if (i.ne.47) cycle
22383 if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle
22384 itypi1=iabs(itype(i+1,1))
22388 call to_box(xi,yi,zi)
22389 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
22390 dxi=dc_norm(1,nres+i)
22391 dyi=dc_norm(2,nres+i)
22392 dzi=dc_norm(3,nres+i)
22393 dsci_inv=vbld_inv(i+nres)
22394 do j=itmp+1,itmp+nres_molec(5)
22396 ! Calculate SC interaction energy.
22397 itypj=iabs(itype(j,5))
22398 if ((itypj.eq.ntyp1)) cycle
22399 CALL elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
22406 call to_box(xj,yj,zj)
22407 ! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj
22409 ! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
22410 ! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
22411 ! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
22412 ! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
22413 ! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
22414 xj=boxshift(xj-xi,boxxsize)
22415 yj=boxshift(yj-yi,boxysize)
22416 zj=boxshift(zj-zi,boxzsize)
22417 ! write(iout,*) "xj,yj,zj", xj,yj,zj,boxxsize
22419 ! dxj = dc_norm( 1, nres+j )
22420 ! dyj = dc_norm( 2, nres+j )
22421 ! dzj = dc_norm( 3, nres+j )
22425 ! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
22426 ! sampling performed with amber package
22430 ! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
22431 chi1 = chi1cat(itypi,itypj)
22432 chis1 = chis1cat(itypi,itypj)
22433 chip1 = chipp1cat(itypi,itypj)
22440 ! chis2 = chis(itypj,itypi)
22441 chis12 = chis1 * chis2
22442 sig1 = sigmap1cat(itypi,itypj)
22443 ! sig2 = sigmap2(itypi,itypj)
22444 ! alpha factors from Fcav/Gcav
22445 b1cav = alphasurcat(1,itypi,itypj)
22446 b2cav = alphasurcat(2,itypi,itypj)
22447 b3cav = alphasurcat(3,itypi,itypj)
22448 b4cav = alphasurcat(4,itypi,itypj)
22455 ! used to determine whether we want to do quadrupole calculations
22456 eps_in = epsintabcat(itypi,itypj)
22457 if (eps_in.eq.0.0) eps_in=1.0
22459 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
22463 ctail(k,1)=c(k,i+nres)
22466 call to_box(ctail(1,1),ctail(2,1),ctail(3,1))
22467 call to_box(ctail(1,2),ctail(2,2),ctail(3,2))
22468 !c! tail distances will be themselves usefull elswhere
22469 !c1 (in Gcav, for example)
22471 Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k))
22474 (Rtail_distance(1)*Rtail_distance(1)) &
22475 + (Rtail_distance(2)*Rtail_distance(2)) &
22476 + (Rtail_distance(3)*Rtail_distance(3)))
22477 ! tail location and distance calculations
22479 d1 = dheadcat(1, 1, itypi, itypj)
22480 ! d2 = dhead(2, 1, itypi, itypj)
22482 ! location of polar head is computed by taking hydrophobic centre
22483 ! and moving by a d1 * dc_norm vector
22484 ! see unres publications for very informative images
22485 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
22486 chead(k,2) = c(k, j)
22488 call to_box(chead(1,1),chead(2,1),chead(3,1))
22489 call to_box(chead(1,2),chead(2,2),chead(3,2))
22490 ! write(iout,*) "TEST",chead(1,1),chead(2,1),chead(3,1),dc_norm(k, i+nres),d1
22492 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22493 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22495 Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k))
22497 ! pitagoras (root of sum of squares)
22499 (Rhead_distance(1)*Rhead_distance(1)) &
22500 + (Rhead_distance(2)*Rhead_distance(2)) &
22501 + (Rhead_distance(3)*Rhead_distance(3)))
22502 !-------------------------------------------------------------------
22503 ! zero everything that should be zero'ed
22522 dscj_inv = vbld_inv(j+nres)
22523 ! print *,i,j,dscj_inv,dsci_inv
22524 ! rij holds 1/(distance of Calpha atoms)
22525 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
22528 ! this should be in elgrad_init but om's are calculated by sc_angular
22529 ! which in turn is used by older potentials
22530 ! om = omega, sqom = om^2
22533 sqom12 = om12 * om12
22535 ! now we calculate EGB - Gey-Berne
22536 ! It will be summed up in evdwij and saved in evdw
22537 sigsq = 1.0D0 / sigsq
22538 sig = sig0ij * dsqrt(sigsq)
22539 ! rij_shift = 1.0D0 / rij - sig + sig0ij
22540 rij_shift = Rtail - sig + sig0ij
22541 IF (rij_shift.le.0.0D0) THEN
22543 if (evdw.gt.1.0d6) then
22544 write (*,'(2(1x,a3,i3),7f7.2)') &
22545 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
22546 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij,sigsq
22547 write(*,*) facsig,faceps1_inv,om1,chiom1,chi1
22548 write(*,*) "ANISO?!",chi1
22549 !evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
22550 ! Equad,evdwij+Fcav+eheadtail,evdw
22555 sigder = -sig * sigsq
22556 rij_shift = 1.0D0 / rij_shift
22557 fac = rij_shift**expon
22558 c1 = fac * fac * aa_aq_cat(itypi,itypj)
22559 ! print *,"ADAM",aa_aq(itypi,itypj)
22562 c2 = fac * bb_aq_cat(itypi,itypj)
22564 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
22565 eps2der = eps3rt * evdwij
22566 eps3der = eps2rt * evdwij
22567 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
22568 evdwij = eps2rt * eps3rt * evdwij
22570 ! IF (bb_aq(itypi,itypj).gt.0) THEN
22571 ! evdw_p = evdw_p + evdwij
22573 ! evdw_m = evdw_m + evdwij
22579 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
22580 fac = -expon * (c1 + evdwij) * rij_shift
22581 sigder = fac * sigder
22582 ! Calculate distance derivative
22586 ! print *,"GG(1),distance grad",gg(1)
22587 fac = chis1 * sqom1 + chis2 * sqom2 &
22588 - 2.0d0 * chis12 * om1 * om2 * om12
22589 pom = 1.0d0 - chis1 * chis2 * sqom12
22590 Lambf = (1.0d0 - (fac / pom))
22591 Lambf = dsqrt(Lambf)
22592 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
22593 Chif = Rtail * sparrow
22594 ChiLambf = Chif * Lambf
22595 eagle = dsqrt(ChiLambf)
22596 bat = ChiLambf ** 11.0d0
22597 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
22598 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
22602 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
22603 dbot = 12.0d0 * b4cav * bat * Lambf
22604 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
22606 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
22607 dbot = 12.0d0 * b4cav * bat * Chif
22608 eagle = Lambf * pom
22609 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
22610 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
22611 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
22612 * (chis2 * om2 * om12 - om1) / (eagle * pom)
22614 dFdL = ((dtop * bot - top * dbot) / botsq)
22615 dCAVdOM1 = dFdL * ( dFdOM1 )
22616 dCAVdOM2 = dFdL * ( dFdOM2 )
22617 dCAVdOM12 = dFdL * ( dFdOM12 )
22620 ertail(k) = Rtail_distance(k)/Rtail
22622 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
22623 erdxj = scalar( ertail(1), dC_norm(1,j) )
22624 facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
22625 facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j)
22627 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
22628 gradpepcatx(k,i) = gradpepcatx(k,i) &
22629 - (( dFdR + gg(k) ) * pom)
22630 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j))
22631 ! gvdwx(k,j) = gvdwx(k,j) &
22632 ! + (( dFdR + gg(k) ) * pom)
22633 gradpepcat(k,i) = gradpepcat(k,i) &
22634 - (( dFdR + gg(k) ) * ertail(k))
22635 gradpepcat(k,j) = gradpepcat(k,j) &
22636 + (( dFdR + gg(k) ) * ertail(k))
22639 !c! Compute head-head and head-tail energies for each state
22640 !! if (.false.) then ! turn off electrostatic
22641 if (itype(j,5).gt.0) then ! the normal cation case
22642 isel = iabs(Qi) + 1 ! ion is always charged so iabs(Qj)
22643 ! print *,i,itype(i,1),isel
22644 IF (isel.eq.0) THEN
22645 !c! No charges - do nothing
22648 ELSE IF (isel.eq.1) THEN
22649 !c! Nonpolar-charge interactions
22650 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
22657 ! eheadtail = 0.0d0
22659 ELSE IF (isel.eq.3) THEN
22660 !c! Dipole-charge interactions
22661 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
22665 ! write(iout,*) "KURWA0",d1
22667 CALL edq_cat(ecl, elj, epol)
22668 eheadtail = ECL + elj + epol
22669 ! eheadtail = 0.0d0
22671 ELSE IF ((isel.eq.2)) THEN
22673 !c! Same charge-charge interaction ( +/+ or -/- )
22674 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
22679 CALL eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
22680 eheadtail = ECL + Egb + Epol + Fisocav + Elj
22681 ! eheadtail = 0.0d0
22683 ! ELSE IF ((isel.eq.2.and. &
22684 ! iabs(Qi).eq.1).and. &
22685 ! nstate(itypi,itypj).ne.1) THEN
22686 !c! Different charge-charge interaction ( +/- or -/+ )
22687 ! if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
22691 ! if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
22696 ! CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
22697 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
22699 write(iout,*) "not yet implemented",j,itype(j,5)
22701 !! endif ! turn off electrostatic
22702 evdw = evdw + Fcav + eheadtail
22703 ! if (evdw.gt.1.0d6) then
22704 ! write (*,'(2(1x,a3,i3),3f6.2,10f16.7)') &
22705 ! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
22706 ! 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
22707 ! Equad,evdwij+Fcav+eheadtail,evdw
22710 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
22711 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
22712 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
22713 Equad,evdwij+Fcav+eheadtail,evdw
22714 ! evdw = evdw + Fcav + eheadtail
22715 ! print *,"before sc_grad_cat", i,j, gradpepcat(1,j)
22716 ! iF (nstate(itypi,itypj).eq.1) THEN
22718 ! print *,"after sc_grad_cat", i,j, gradpepcat(1,j)
22721 !c!-------------------------------------------------------------------
22725 !c write (iout,*) "Number of loop steps in EGB:",ind
22726 !c energy_dec=.false.
22727 ! print *,"EVDW KURW",evdw,nres
22731 do i=ibond_start,ibond_end
22733 ! print *,"I am in EVDW",i
22734 itypi=10 ! the peptide group parameters are for glicine
22736 ! if (i.ne.47) cycle
22737 if ((itype(i,1).eq.ntyp1).or.itype(i+1,1).eq.ntyp1) cycle
22738 itypi1=iabs(itype(i+1,1))
22739 xi=(c(1,i)+c(1,i+1))/2.0
22740 yi=(c(2,i)+c(2,i+1))/2.0
22741 zi=(c(3,i)+c(3,i+1))/2.0
22742 call to_box(xi,yi,zi)
22746 dsci_inv=vbld_inv(i+1)/2.0
22747 do j=itmp+1,itmp+nres_molec(5)
22749 ! Calculate SC interaction energy.
22750 itypj=iabs(itype(j,5))
22751 if ((itypj.eq.ntyp1)) cycle
22752 CALL elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
22758 call to_box(xj,yj,zj)
22759 xj=boxshift(xj-xi,boxxsize)
22760 yj=boxshift(yj-yi,boxysize)
22761 zj=boxshift(zj-zi,boxzsize)
22763 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22765 dxj = 0.0d0! dc_norm( 1, nres+j )
22766 dyj = 0.0d0!dc_norm( 2, nres+j )
22767 dzj = 0.0d0! dc_norm( 3, nres+j )
22771 ! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
22772 ! sampling performed with amber package
22776 ! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
22777 chi1 = chi1cat(itypi,itypj)
22778 chis1 = chis1cat(itypi,itypj)
22779 chip1 = chipp1cat(itypi,itypj)
22786 ! chis2 = chis(itypj,itypi)
22787 chis12 = chis1 * chis2
22788 sig1 = sigmap1cat(itypi,itypj)
22789 ! sig2 = sigmap2(itypi,itypj)
22790 ! alpha factors from Fcav/Gcav
22791 b1cav = alphasurcat(1,itypi,itypj)
22792 b2cav = alphasurcat(2,itypi,itypj)
22793 b3cav = alphasurcat(3,itypi,itypj)
22794 b4cav = alphasurcat(4,itypi,itypj)
22796 ! used to determine whether we want to do quadrupole calculations
22797 eps_in = epsintabcat(itypi,itypj)
22798 if (eps_in.eq.0.0) eps_in=1.0
22800 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
22804 ctail(k,1)=(c(k,i)+c(k,i+1))/2.0
22807 call to_box(ctail(1,1),ctail(2,1),ctail(3,1))
22808 call to_box(ctail(1,2),ctail(2,2),ctail(3,2))
22809 !c! tail distances will be themselves usefull elswhere
22810 !c1 (in Gcav, for example)
22812 Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k))
22815 !c! tail distances will be themselves usefull elswhere
22816 !c1 (in Gcav, for example)
22818 (Rtail_distance(1)*Rtail_distance(1)) &
22819 + (Rtail_distance(2)*Rtail_distance(2)) &
22820 + (Rtail_distance(3)*Rtail_distance(3)))
22821 ! tail location and distance calculations
22823 d1 = dheadcat(1, 1, itypi, itypj)
22826 ! d2 = dhead(2, 1, itypi, itypj)
22828 ! location of polar head is computed by taking hydrophobic centre
22829 ! and moving by a d1 * dc_norm vector
22830 ! see unres publications for very informative images
22831 chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
22832 chead(k,2) = c(k, j)
22835 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22836 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22837 call to_box(chead(1,1),chead(2,1),chead(3,1))
22838 call to_box(chead(1,2),chead(2,2),chead(3,2))
22841 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22842 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22844 Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k))
22847 ! pitagoras (root of sum of squares)
22849 (Rhead_distance(1)*Rhead_distance(1)) &
22850 + (Rhead_distance(2)*Rhead_distance(2)) &
22851 + (Rhead_distance(3)*Rhead_distance(3)))
22852 !-------------------------------------------------------------------
22853 ! zero everything that should be zero'ed
22871 dscj_inv = vbld_inv(j+nres)
22872 ! print *,i,j,dscj_inv,dsci_inv
22873 ! rij holds 1/(distance of Calpha atoms)
22874 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
22877 ! this should be in elgrad_init but om's are calculated by sc_angular
22878 ! which in turn is used by older potentials
22879 ! om = omega, sqom = om^2
22882 sqom12 = om12 * om12
22884 ! now we calculate EGB - Gey-Berne
22885 ! It will be summed up in evdwij and saved in evdw
22886 sigsq = 1.0D0 / sigsq
22887 sig = sig0ij * dsqrt(sigsq)
22888 ! rij_shift = 1.0D0 / rij - sig + sig0ij
22889 rij_shift = Rtail - sig + sig0ij
22890 IF (rij_shift.le.0.0D0) THEN
22892 ! if (evdw.gt.1.0d6) then
22893 ! write (*,'(2(1x,a3,i3),6f6.2)') &
22894 ! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
22895 ! 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij
22896 !evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
22897 ! Equad,evdwij+Fcav+eheadtail,evdw
22901 sigder = -sig * sigsq
22902 rij_shift = 1.0D0 / rij_shift
22903 fac = rij_shift**expon
22904 c1 = fac * fac * aa_aq_cat(itypi,itypj)
22905 ! print *,"ADAM",aa_aq(itypi,itypj)
22908 c2 = fac * bb_aq_cat(itypi,itypj)
22910 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
22911 eps2der = eps3rt * evdwij
22912 eps3der = eps2rt * evdwij
22913 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
22914 evdwij = eps2rt * eps3rt * evdwij
22916 ! IF (bb_aq(itypi,itypj).gt.0) THEN
22917 ! evdw_p = evdw_p + evdwij
22919 ! evdw_m = evdw_m + evdwij
22925 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
22926 fac = -expon * (c1 + evdwij) * rij_shift
22927 sigder = fac * sigder
22928 ! Calculate distance derivative
22933 fac = chis1 * sqom1 + chis2 * sqom2 &
22934 - 2.0d0 * chis12 * om1 * om2 * om12
22936 pom = 1.0d0 - chis1 * chis2 * sqom12
22937 ! print *,"TUT2",fac,chis1,sqom1,pom
22938 Lambf = (1.0d0 - (fac / pom))
22939 Lambf = dsqrt(Lambf)
22940 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
22941 Chif = Rtail * sparrow
22942 ChiLambf = Chif * Lambf
22943 eagle = dsqrt(ChiLambf)
22944 bat = ChiLambf ** 11.0d0
22945 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
22946 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
22950 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
22951 dbot = 12.0d0 * b4cav * bat * Lambf
22952 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
22954 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
22955 dbot = 12.0d0 * b4cav * bat * Chif
22956 eagle = Lambf * pom
22957 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
22958 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
22959 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
22960 * (chis2 * om2 * om12 - om1) / (eagle * pom)
22962 dFdL = ((dtop * bot - top * dbot) / botsq)
22963 dCAVdOM1 = dFdL * ( dFdOM1 )
22964 dCAVdOM2 = dFdL * ( dFdOM2 )
22965 dCAVdOM12 = dFdL * ( dFdOM12 )
22968 ertail(k) = Rtail_distance(k)/Rtail
22970 erdxi = scalar( ertail(1), dC_norm(1,i) )
22971 erdxj = scalar( ertail(1), dC_norm(1,j) )
22972 facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i)
22973 facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j+nres)
22975 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i))
22976 ! gradpepcatx(k,i) = gradpepcatx(k,i) &
22977 ! - (( dFdR + gg(k) ) * pom)
22978 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
22979 ! gvdwx(k,j) = gvdwx(k,j) &
22980 ! + (( dFdR + gg(k) ) * pom)
22981 gradpepcat(k,i) = gradpepcat(k,i) &
22982 - (( dFdR + gg(k) ) * ertail(k))/2.0d0
22983 gradpepcat(k,i+1) = gradpepcat(k,i+1) &
22984 - (( dFdR + gg(k) ) * ertail(k))/2.0d0
22986 gradpepcat(k,j) = gradpepcat(k,j) &
22987 + (( dFdR + gg(k) ) * ertail(k))
22990 if (itype(j,5).gt.0) then
22991 !c! Compute head-head and head-tail energies for each state
22993 !c! Dipole-charge interactions
22994 CALL edq_cat_pep(ecl, elj, epol)
22995 eheadtail = ECL + elj + epol
22996 ! print *,"i,",i,eheadtail
22997 ! eheadtail = 0.0d0
22999 !HERE WATER and other types of molecules solvents will be added
23000 write(iout,*) "not yet implemented"
23003 evdw = evdw + Fcav + eheadtail
23004 ! if (evdw.gt.1.0d6) then
23005 ! write (*,'(2(1x,a3,i3),3f6.2,10f16.7)') &
23006 ! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
23007 ! 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
23008 ! Equad,evdwij+Fcav+eheadtail,evdw
23010 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
23011 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
23012 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
23013 Equad,evdwij+Fcav+eheadtail,evdw
23014 ! evdw = evdw + Fcav + eheadtail
23016 ! iF (nstate(itypi,itypj).eq.1) THEN
23017 CALL sc_grad_cat_pep
23019 !c!-------------------------------------------------------------------
23023 !c write (iout,*) "Number of loop steps in EGB:",ind
23024 !c energy_dec=.false.
23025 ! print *,"EVDW KURW",evdw,nres
23027 ! print *,"before leave sc_grad_cat", i,j, gradpepcat(1,nres-1)
23030 end subroutine ecats_prot_amber
23032 !---------------------------------------------------------------------------
23034 subroutine ecat_prot(ecation_prot)
23037 integer i,j,k,subchap,itmp,inum
23038 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
23039 r7,r4,ecationcation
23040 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
23041 dist_init,dist_temp,ecation_prot,rcal,rocal, &
23042 Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
23043 catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
23044 wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
23045 costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
23046 Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
23047 rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
23048 opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
23049 opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
23050 Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip,&
23052 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
23053 gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
23054 dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
23055 tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
23056 v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
23057 dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
23058 dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
23059 dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
23061 real(kind=8),dimension(6) :: vcatprm
23063 ! first lets calculate interaction with peptide groups
23064 if (nres_molec(5).eq.0) return
23067 itmp=itmp+nres_molec(i)
23069 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
23070 do i=ibond_start,ibond_end
23072 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
23073 xi=0.5d0*(c(1,i)+c(1,i+1))
23074 yi=0.5d0*(c(2,i)+c(2,i+1))
23075 zi=0.5d0*(c(3,i)+c(3,i+1))
23076 call to_box(xi,yi,zi)
23078 do j=itmp+1,itmp+nres_molec(5)
23079 ! print *,"WTF",itmp,j,i
23080 ! all parameters were for Ca2+ to approximate single charge divide by two
23082 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23084 wdip =1.092777950857032D2
23086 wmodquad=-2.174122713004870D4
23087 wmodquad=wmodquad/wconst
23088 wquad1 = 3.901232068562804D1
23089 wquad1=wquad1/wconst
23091 wquad2=wquad2/wconst
23099 call to_box(xj,yj,zj)
23100 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23103 rcpm = sqrt(xj**2+yj**2+zj**2)
23104 drcp_norm(1)=xj/rcpm
23105 drcp_norm(2)=yj/rcpm
23106 drcp_norm(3)=zj/rcpm
23109 dcmag=dcmag+dc(k,i)**2
23113 myd_norm(k)=dc(k,i)/dcmag
23115 costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
23116 drcp_norm(3)*myd_norm(3)
23119 Irsecp = 1.0d0/rsecp
23120 Irthrp = Irsecp/rcpm
23121 Irfourp = Irthrp/rcpm
23122 Irfiftp = Irfourp/rcpm
23123 Irsistp=Irfiftp/rcpm
23124 Irseven=Irsistp/rcpm
23125 Irtwelv=Irsistp*Irsistp
23126 Irthir=Irtwelv/rcpm
23127 sin2thet = (1-costhet*costhet)
23128 sinthet=sqrt(sin2thet)
23129 E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
23131 E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
23132 2*wvan2**6*Irsistp)
23133 ecation_prot = ecation_prot+E1+E2
23134 ! print *,"ecatprot",i,j,ecation_prot,rcpm
23135 dE1dr = -2*costhet*wdip*Irthrp-&
23136 (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
23137 dE2dr = 3*wquad1*wquad2*Irfourp- &
23138 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
23139 dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
23141 drdpep(k) = -drcp_norm(k)
23142 dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
23143 dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
23144 dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
23145 dEddci(k) = dEdcos*dcosddci(k)
23148 gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
23149 gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
23150 gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
23154 !------------------------------------------sidechains
23155 ! do i=1,nres_molec(1)
23156 do i=ibond_start,ibond_end
23157 if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
23159 ! print *,i,ecation_prot
23163 call to_box(xi,yi,zi)
23165 cm1(k)=dc(k,i+nres)
23167 cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
23168 do j=itmp+1,itmp+nres_molec(5)
23170 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23175 call to_box(xj,yj,zj)
23176 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23180 if((itype(i,1).eq.15.or.itype(i,1).eq.16).or.&
23181 ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.&
23182 (itype(i,1).eq.25))) then
23183 if(itype(i,1).eq.16) then
23189 vcatprm(k)=catprm(k,inum)
23191 dASGL=catprm(7,inum)
23193 ! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
23194 vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
23195 vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
23196 vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
23200 if (subchap.eq.1) then
23209 valpha(1)=xi-c(1,i+nres)+c(1,i)
23210 valpha(2)=yi-c(2,i+nres)+c(2,i)
23211 valpha(3)=zi-c(3,i+nres)+c(3,i)
23215 dx(k) = vcat(k)-vcm(k)
23218 v1(k)=(vcm(k)-valpha(k))
23219 v2(k)=(vcat(k)-valpha(k))
23221 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
23222 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
23223 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
23225 ! The weights of the energy function calculated from
23226 !The quantum mechanical GAMESS simulations of calcium with ASP/GLU
23227 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
23233 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23242 wquad2 = vcatprm(4)
23244 wquad2p = 1.0d0-wquad2
23247 opt = dx(1)**2+dx(2)**2
23248 rsecp = opt+dx(3)**2
23252 rsixp = rfourp*rsecp
23255 Irsecp = 1.0d0/rsecp
23257 Irfourp = Irthrp/rs
23258 Irsixp = 1.0d0/rsixp
23259 Ireight=1.0d0/reight
23263 opt1 = (4*rs*dx(3)*wdip)
23264 opt2 = 6*rsecp*wquad1*opt
23265 opt3 = wquad1*wquad2p*Irsixp
23266 opt4 = (wvan1*wvan2**12)
23267 opt5 = opt4*12*Irfourt
23268 opt6 = 2*wvan1*wvan2**6
23269 opt7 = 6*opt6*Ireight
23272 opt11 = (rsecp*v2m)**2
23273 opt12 = (rsecp*v1m)**2
23274 opt14 = (v1m*v2m*rsecp)**2
23275 opt15 = -wquad1/v2m**2
23276 opt16 = (rthrp*(v1m*v2m)**2)**2
23277 opt17 = (v1m**2*rthrp)**2
23278 opt18 = -wquad1/rthrp
23279 opt19 = (v1m**2*v2m**2)**2
23282 dEcCat(k) = -(dx(k)*wc)*Irthrp
23283 dEcCm(k)=(dx(k)*wc)*Irthrp
23286 Edip=opt8*(v1dpv2)/(rsecp*v2m)
23288 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
23289 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
23290 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
23291 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
23292 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
23293 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
23296 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
23298 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
23299 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
23300 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
23301 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
23302 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
23303 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
23304 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
23305 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
23308 Equad2=wquad1*wquad2p*Irthrp
23310 dEquad2Cat(k)=-3*dx(k)*rs*opt3
23311 dEquad2Cm(k)=3*dx(k)*rs*opt3
23312 dEquad2Calp(k)=0.0d0
23316 dEvan1Cat(k)=-dx(k)*opt5
23317 dEvan1Cm(k)=dx(k)*opt5
23318 dEvan1Calp(k)=0.0d0
23322 dEvan2Cat(k)=dx(k)*opt7
23323 dEvan2Cm(k)=-dx(k)*opt7
23324 dEvan2Calp(k)=0.0d0
23326 ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
23327 ! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
23330 dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
23331 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
23332 !c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
23333 dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
23334 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
23335 dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
23336 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
23340 dscvec(k) = dc(k,i+nres)
23341 dscmag = dscmag+dscvec(k)*dscvec(k)
23344 dscmag = sqrt(dscmag)
23345 dscmag3 = dscmag3*dscmag
23346 constA = 1.0d0+dASGL/dscmag
23349 constB = constB+dscvec(k)*dEtotalCm(k)
23351 constB = constB*dASGL/dscmag3
23353 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
23354 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
23355 constA*dEtotalCm(k)-constB*dscvec(k)
23356 ! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
23357 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
23358 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
23360 else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
23361 if(itype(i,1).eq.14) then
23367 vcatprm(k)=catprm(k,inum)
23369 dASGL=catprm(7,inum)
23371 ! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
23375 vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
23376 vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
23377 vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
23378 if (subchap.eq.1) then
23387 valpha(1)=xi-c(1,i+nres)+c(1,i)
23388 valpha(2)=yi-c(2,i+nres)+c(2,i)
23389 valpha(3)=zi-c(3,i+nres)+c(3,i)
23393 dx(k) = vcat(k)-vcm(k)
23396 v1(k)=(vcm(k)-valpha(k))
23397 v2(k)=(vcat(k)-valpha(k))
23399 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
23400 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
23401 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
23402 ! The weights of the energy function calculated from
23403 !The quantum mechanical GAMESS simulations of ASN/GLN with calcium
23405 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23412 wquad2 = vcatprm(4)
23417 opt = dx(1)**2+dx(2)**2
23418 rsecp = opt+dx(3)**2
23422 rsixp = rfourp*rsecp
23427 Irfourp = Irthrp/rs
23433 opt1 = (4*rs*dx(3)*wdip)
23434 opt2 = 6*rsecp*wquad1*opt
23435 opt3 = wquad1*wquad2p*Irsixp
23436 opt4 = (wvan1*wvan2**12)
23437 opt5 = opt4*12*Irfourt
23438 opt6 = 2*wvan1*wvan2**6
23439 opt7 = 6*opt6*Ireight
23442 opt11 = (rsecp*v2m)**2
23443 opt12 = (rsecp*v1m)**2
23444 opt14 = (v1m*v2m*rsecp)**2
23445 opt15 = -wquad1/v2m**2
23446 opt16 = (rthrp*(v1m*v2m)**2)**2
23447 opt17 = (v1m**2*rthrp)**2
23448 opt18 = -wquad1/rthrp
23449 opt19 = (v1m**2*v2m**2)**2
23450 Edip=opt8*(v1dpv2)/(rsecp*v2m)
23452 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
23453 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
23454 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
23455 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
23456 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
23457 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
23460 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
23462 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
23463 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
23464 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
23465 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
23466 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
23467 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
23468 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
23469 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
23472 Equad2=wquad1*wquad2p*Irthrp
23474 dEquad2Cat(k)=-3*dx(k)*rs*opt3
23475 dEquad2Cm(k)=3*dx(k)*rs*opt3
23476 dEquad2Calp(k)=0.0d0
23480 dEvan1Cat(k)=-dx(k)*opt5
23481 dEvan1Cm(k)=dx(k)*opt5
23482 dEvan1Calp(k)=0.0d0
23486 dEvan2Cat(k)=dx(k)*opt7
23487 dEvan2Cm(k)=-dx(k)*opt7
23488 dEvan2Calp(k)=0.0d0
23490 ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
23492 dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
23493 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
23494 dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
23495 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
23496 dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
23497 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
23501 dscvec(k) = c(k,i+nres)-c(k,i)
23507 dscmag = dscmag+dscvec(k)*dscvec(k)
23510 dscmag = sqrt(dscmag)
23511 dscmag3 = dscmag3*dscmag
23512 constA = 1+dASGL/dscmag
23515 constB = constB+dscvec(k)*dEtotalCm(k)
23517 constB = constB*dASGL/dscmag3
23519 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
23520 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
23521 constA*dEtotalCm(k)-constB*dscvec(k)
23522 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
23523 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
23528 ! r(k) = c(k,j)-c(k,i+nres)
23532 rcal = rcal+r(k)*r(k)
23537 r0p=0.5*(rocal+sig0(itype(i,1)))
23540 Evan1=epscalc*(r012/rcal**6)
23541 Evan2=epscalc*2*(r06/rcal**3)
23545 dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
23546 dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
23549 dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
23551 ecation_prot = ecation_prot+ Evan1+Evan2
23553 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
23555 gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
23556 gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
23558 endif ! 13-16 residues
23562 end subroutine ecat_prot
23564 !----------------------------------------------------------------------------
23565 !---------------------------------------------------------------------------
23566 subroutine ecat_nucl(ecation_nucl)
23567 integer i,j,k,subchap,itmp,inum,itypi,itypj
23568 real(kind=8) :: xi,yi,zi,xj,yj,zj
23569 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
23570 dist_init,dist_temp,ecation_nucl,Evan1,Evan2,Ecav,Egb,wdip1,wdip2, &
23571 wvan1,wvan2,wgbsig,wgbeps,wgbchi,wgbchip,wcav1,wcav2,wcav3,wcav4, &
23572 wcavsig,wcavchi,v1m,v1dpdx,wh2o,wc,Edip,rcs2,invrcs6,invrcs8,invrcs12, &
23573 invrcs14,rcb,rcb2,invrcb,invrcb2,invrcb4,invrcb6,cosinus,cos2,dcosdcatconst, &
23574 dcosdcalpconst,dcosdcmconst,rcav,rcav11,rcav12,constcav1,constcav2, &
23575 constgb1,constgb2,constdvan1,constdvan2,sgb,sgb6,sgb7,sgb12,sgb13, &
23576 cavnum,cavdenom,invcavdenom2,dcavnumdcos,dcavnumdr,dcavdenomdcos, &
23577 dcavdenomdr,sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
23578 real(kind=8),dimension(3) ::gg,r,dEtotalCm,dEtotalCalp,dEvan1Cm,&
23579 dEvan2Cm,cm1,cm,vcat,vsug,v1,v2,dx,vcm,dEdipCm,dEdipCalp, &
23580 dEvan1Calp,dEvan2Cat,dEvan2Calp,dEtotalCat,dEdipCat,dEvan1Cat,dcosdcat, &
23581 dcosdcalp,dcosdcm,dEgbdCat,dEgbdCalp,dEgbdCm,dEcavdCat,dEcavdCalp, &
23583 real(kind=8),dimension(14) :: vcatnuclprm
23589 if (nres_molec(5).eq.0) return
23592 itmp=itmp+nres_molec(i)
23594 do i=iatsc_s_nucl,iatsc_e_nucl
23595 if ((itype(i,2).eq.ntyp1_molec(2))) cycle ! leave dummy atoms
23599 call to_box(xi,yi,zi)
23600 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
23602 cm1(k)=dc(k,i+nres)
23604 do j=itmp+1,itmp+nres_molec(5)
23608 call to_box(xj,yj,zj)
23609 ! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj
23610 ! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
23611 ! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
23612 ! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
23613 ! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
23614 ! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
23615 xj=boxshift(xj-xi,boxxsize)
23616 yj=boxshift(yj-yi,boxysize)
23617 zj=boxshift(zj-zi,boxzsize)
23618 ! write(iout,*) 'after shift', xj,yj,zj
23619 dist_init=xj**2+yj**2+zj**2
23624 vcatnuclprm(k)=catnuclprm(k,itypi,itypj)
23631 call to_box(vcm(1),vcm(2),vcm(3))
23632 call to_box(vsug(1),vsug(2),vsug(3))
23633 call to_box(vcat(1),vcat(2),vcat(3))
23635 ! dx(k) = vcat(k)-vcm(k)
23637 dx(k)=boxshift(vcat(k)-vcm(k),boxik(k))
23640 v2(k)=boxshift(vcat(k)-vsug(k),boxik(k))
23642 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
23643 v1dpdx = v1(1)*dx(1)+v1(2)*dx(2)+v1(3)*dx(3)
23644 ! The weights of the energy function calculated from
23645 !The quantum mechanical Gaussian simulations of potassium and sodium with deoxynucleosides
23647 wdip1 = vcatnuclprm(1)
23648 wdip1 = wdip1/wh2o !w1
23649 wdip2 = vcatnuclprm(2)
23650 wdip2 = wdip2/wh2o !w2
23651 wvan1 = vcatnuclprm(3)
23652 wvan2 = vcatnuclprm(4) !pis1
23653 wgbsig = vcatnuclprm(5) !sigma0
23654 wgbeps = vcatnuclprm(6) !epsi0
23655 wgbchi = vcatnuclprm(7) !chi1
23656 wgbchip = vcatnuclprm(8) !chip1
23657 wcavsig = vcatnuclprm(9) !sig
23658 wcav1 = vcatnuclprm(10) !b1
23659 wcav2 = vcatnuclprm(11) !b2
23660 wcav3 = vcatnuclprm(12) !b3
23661 wcav4 = vcatnuclprm(13) !b4
23662 wcavchi = vcatnuclprm(14) !chis1
23663 rcs2 = v2(1)**2+v2(2)**2+v2(3)**2
23664 invrcs6 = 1/rcs2**3
23665 invrcs8 = invrcs6/rcs2
23666 invrcs12 = invrcs6**2
23667 invrcs14 = invrcs12/rcs2
23668 rcb2 = dx(1)**2+dx(2)**2+dx(3)**2
23671 invrcb2 = invrcb**2
23672 invrcb4 = invrcb2**2
23673 invrcb6 = invrcb4*invrcb2
23674 cosinus = v1dpdx/(v1m*rcb)
23676 dcosdcatconst = invrcb2/v1m
23677 dcosdcalpconst = invrcb/v1m**2
23678 dcosdcmconst = invrcb2/v1m**2
23680 dcosdcat(k) = (v1(k)*rcb-dx(k)*v1m*cosinus)*dcosdcatconst
23681 dcosdcalp(k) = (v1(k)*rcb*cosinus-dx(k)*v1m)*dcosdcalpconst
23682 dcosdcm(k) = ((dx(k)-v1(k))*v1m*rcb+ &
23683 cosinus*(dx(k)*v1m**2-v1(k)*rcb2))*dcosdcmconst
23687 rcav12 = rcav11*rcav
23688 constcav1 = 1-wcavchi*cos2
23689 constcav2 = sqrt(constcav1)
23690 constgb1 = 1/sqrt(1-wgbchi*cos2)
23691 constgb2 = wgbeps*(1-wgbchip*cos2)**2
23692 constdvan1 = 12*wvan1*wvan2**12*invrcs14
23693 constdvan2 = 6*wvan1*wvan2**6*invrcs8
23694 !----------------------------------------------------------------------------
23696 !---------------------------------------------------------------------------
23697 sgb = 1/(1-constgb1+(rcb/wgbsig))
23702 Egb = constgb2*(sgb12-sgb6)
23704 dEgbdCat(k) = -constgb2/wgbsig*(12*sgb13-6*sgb7)*invrcb*dx(k) &
23705 +(constgb1**3*constgb2*wgbchi*cosinus*(12*sgb13-6*sgb7) &
23706 -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcat(k)
23707 dEgbdCm(k) = constgb2/wgbsig*(12*sgb13-6*sgb7)*invrcb*dx(k) &
23708 +(constgb1**3*constgb2*wgbchi*cosinus*(12*sgb13-6*sgb7) &
23709 -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcm(k)
23710 dEgbdCalp(k) = (constgb1**3*constgb2*wgbchi*cosinus &
23711 *(12*sgb13-6*sgb7) &
23712 -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcalp(k)
23714 !----------------------------------------------------------------------------
23716 !---------------------------------------------------------------------------
23717 cavnum = sqrt(rcav*constcav2)+wcav2*rcav*constcav2-wcav3
23718 cavdenom = 1+wcav4*rcav12*constcav1**6
23719 Ecav = wcav1*cavnum/cavdenom
23720 invcavdenom2 = 1/cavdenom**2
23721 dcavnumdcos = -wcavchi*cosinus/constcav2 &
23722 *(sqrt(rcav/constcav2)/2+wcav2*rcav)
23723 dcavnumdr = (0.5*sqrt(constcav2/rcav)+wcav2*constcav2)/wcavsig
23724 dcavdenomdcos = -12*wcav4*wcavchi*rcav12*constcav1**5*cosinus
23725 dcavdenomdr = 12*wcav4/wcavsig*rcav11*constcav1**6
23727 dEcavdCat(k) = ((dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
23728 *dcosdcat(k)+(dcavnumdr*cavdenom-dcavdenomdr*cavnum)/rcb*dx(k))*wcav1*invcavdenom2
23729 dEcavdCm(k) = ((dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
23730 *dcosdcm(k)-(dcavnumdr*cavdenom-dcavdenomdr*cavnum)/rcb*dx(k))*wcav1*invcavdenom2
23731 dEcavdCalp(k) = (dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
23732 *dcosdcalp(k)*wcav1*invcavdenom2
23734 !----------------------------------------------------------------------------
23735 !van der Waals and dipole-charge interaction energy
23736 !---------------------------------------------------------------------------
23737 Evan1 = wvan1*wvan2**12*invrcs12
23739 dEvan1Cat(k) = -v2(k)*constdvan1
23740 dEvan1Cm(k) = 0.0d0
23741 dEvan1Calp(k) = v2(k)*constdvan1
23743 Evan2 = -wvan1*wvan2**6*invrcs6
23745 dEvan2Cat(k) = v2(k)*constdvan2
23746 dEvan2Cm(k) = 0.0d0
23747 dEvan2Calp(k) = -v2(k)*constdvan2
23749 Edip = wdip1*cosinus*invrcb2-wdip2*(1-cos2)*invrcb4
23751 dEdipCat(k) = (-2*wdip1*cosinus*invrcb4 &
23752 +4*wdip2*(1-cos2)*invrcb6)*dx(k) &
23753 +dcosdcat(k)*(wdip1*invrcb2+2*wdip2*cosinus*invrcb4)
23754 dEdipCm(k) = (2*wdip1*cosinus*invrcb4 &
23755 -4*wdip2*(1-cos2)*invrcb6)*dx(k) &
23756 +dcosdcm(k)*(wdip1*invrcb2+2*wdip2*cosinus*invrcb4)
23757 dEdipCalp(k) = dcosdcalp(k)*(wdip1*invrcb2 &
23758 +2*wdip2*cosinus*invrcb4)
23760 if (energy_dec) write (iout,'(2i5,4(a6,f7.3))') i,j, &
23761 ' E GB ',Egb,' ECav ',Ecav,' Evdw ',Evan1+Evan2,' Edip ',Edip
23762 ecation_nucl=ecation_nucl+Ecav+Egb+Edip+Evan1+Evan2
23764 dEtotalCat(k) = dEcavdCat(k)+dEvan1Cat(k)+dEvan2Cat(k) &
23765 +dEgbdCat(k)+dEdipCat(k)
23766 dEtotalCm(k) = dEcavdCm(k)+dEvan1Cm(k)+dEvan2Cm(k) &
23767 +dEgbdCm(k)+dEdipCm(k)
23768 dEtotalCalp(k) = dEcavdCalp(k)+dEgbdCalp(k)+dEvan1Calp(k) &
23769 +dEdipCalp(k)+dEvan2Calp(k)
23772 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
23773 gradnuclcatx(k,i)=gradnuclcatx(k,i)+dEtotalCm(k)
23774 gradnuclcat(k,i)=gradnuclcat(k,i)+gg(k)
23775 gradnuclcat(k,j)=gradnuclcat(k,j)+dEtotalCat(k)
23780 end subroutine ecat_nucl
23782 !-----------------------------------------------------------------------------
23783 !-----------------------------------------------------------------------------
23784 subroutine eprot_sc_base(escbase)
23786 ! implicit real*8 (a-h,o-z)
23787 ! include 'DIMENSIONS'
23788 ! include 'COMMON.GEO'
23789 ! include 'COMMON.VAR'
23790 ! include 'COMMON.LOCAL'
23791 ! include 'COMMON.CHAIN'
23792 ! include 'COMMON.DERIV'
23793 ! include 'COMMON.NAMES'
23794 ! include 'COMMON.INTERACT'
23795 ! include 'COMMON.IOUNITS'
23796 ! include 'COMMON.CALC'
23797 ! include 'COMMON.CONTROL'
23798 ! include 'COMMON.SBRIDGE'
23800 !el local variables
23801 integer :: iint,itypi,itypi1,itypj,subchap
23802 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23803 real(kind=8) :: evdw,sig0ij
23804 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23805 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23806 sslipi,sslipj,faclip
23808 real(kind=8) :: fracinbuf
23809 real (kind=8) :: escbase
23810 real (kind=8),dimension(4):: ener
23811 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23812 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23813 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
23814 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23815 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
23816 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23817 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23818 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
23819 real(kind=8),dimension(3,2)::chead,erhead_tail
23820 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23824 ! do i=1,nres_molec(1)
23825 do i=ibond_start,ibond_end
23826 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23828 dxi = dc_norm(1,nres+i)
23829 dyi = dc_norm(2,nres+i)
23830 dzi = dc_norm(3,nres+i)
23831 dsci_inv = vbld_inv(i+nres)
23835 call to_box(xi,yi,zi)
23836 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
23837 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
23839 if (itype(j,2).eq.ntyp1_molec(2))cycle
23843 call to_box(xj,yj,zj)
23844 ! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
23845 ! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
23846 ! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
23847 ! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
23848 ! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
23849 xj=boxshift(xj-xi,boxxsize)
23850 yj=boxshift(yj-yi,boxysize)
23851 zj=boxshift(zj-zi,boxzsize)
23853 dxj = dc_norm( 1, nres+j )
23854 dyj = dc_norm( 2, nres+j )
23855 dzj = dc_norm( 3, nres+j )
23856 ! print *,i,j,itypi,itypj
23857 d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
23858 d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
23861 ! BetaT = 1.0d0 / (298.0d0 * Rb)
23863 sig0ij = sigma_scbase( itypi,itypj )
23864 chi1 = chi_scbase( itypi, itypj,1 )
23865 chi2 = chi_scbase( itypi, itypj,2 )
23868 chi12 = chi1 * chi2
23869 chip1 = chipp_scbase( itypi, itypj,1 )
23870 chip2 = chipp_scbase( itypi, itypj,2 )
23873 chip12 = chip1 * chip2
23874 ! not used by momo potential, but needed by sc_angular which is shared
23875 ! by all energy_potential subroutines
23879 a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
23880 ! a12sq = a12sq * a12sq
23881 ! charge of amino acid itypi is...
23882 chis1 = chis_scbase(itypi,itypj,1)
23883 chis2 = chis_scbase(itypi,itypj,2)
23884 chis12 = chis1 * chis2
23885 sig1 = sigmap1_scbase(itypi,itypj)
23886 sig2 = sigmap2_scbase(itypi,itypj)
23887 ! write (*,*) "sig1 = ", sig1
23888 ! write (*,*) "sig2 = ", sig2
23889 ! alpha factors from Fcav/Gcav
23890 b1 = alphasur_scbase(1,itypi,itypj)
23892 b2 = alphasur_scbase(2,itypi,itypj)
23893 b3 = alphasur_scbase(3,itypi,itypj)
23894 b4 = alphasur_scbase(4,itypi,itypj)
23895 ! used to determine whether we want to do quadrupole calculations
23897 eps_in = epsintab_scbase(itypi,itypj)
23898 if (eps_in.eq.0.0) eps_in=1.0
23899 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
23900 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
23901 !-------------------------------------------------------------------
23902 ! tail location and distance calculations
23904 ! location of polar head is computed by taking hydrophobic centre
23905 ! and moving by a d1 * dc_norm vector
23906 ! see unres publications for very informative images
23907 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
23908 chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
23910 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23911 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23912 Rhead_distance(k) = chead(k,2) - chead(k,1)
23914 ! pitagoras (root of sum of squares)
23916 (Rhead_distance(1)*Rhead_distance(1)) &
23917 + (Rhead_distance(2)*Rhead_distance(2)) &
23918 + (Rhead_distance(3)*Rhead_distance(3)))
23919 !-------------------------------------------------------------------
23920 ! zero everything that should be zero'ed
23938 dscj_inv = vbld_inv(j+nres)
23939 ! print *,i,j,dscj_inv,dsci_inv
23940 ! rij holds 1/(distance of Calpha atoms)
23941 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23943 !----------------------------
23945 ! this should be in elgrad_init but om's are calculated by sc_angular
23946 ! which in turn is used by older potentials
23947 ! om = omega, sqom = om^2
23950 sqom12 = om12 * om12
23952 ! now we calculate EGB - Gey-Berne
23953 ! It will be summed up in evdwij and saved in evdw
23954 sigsq = 1.0D0 / sigsq
23955 sig = sig0ij * dsqrt(sigsq)
23956 ! rij_shift = 1.0D0 / rij - sig + sig0ij
23957 rij_shift = 1.0/rij - sig + sig0ij
23958 IF (rij_shift.le.0.0D0) THEN
23962 sigder = -sig * sigsq
23963 rij_shift = 1.0D0 / rij_shift
23964 fac = rij_shift**expon
23965 c1 = fac * fac * aa_scbase(itypi,itypj)
23967 c2 = fac * bb_scbase(itypi,itypj)
23969 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23970 eps2der = eps3rt * evdwij
23971 eps3der = eps2rt * evdwij
23972 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23973 evdwij = eps2rt * eps3rt * evdwij
23974 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23975 fac = -expon * (c1 + evdwij) * rij_shift
23976 sigder = fac * sigder
23978 ! Calculate distance derivative
23982 ! if (b2.gt.0.0) then
23983 fac = chis1 * sqom1 + chis2 * sqom2 &
23984 - 2.0d0 * chis12 * om1 * om2 * om12
23985 ! we will use pom later in Gcav, so dont mess with it!
23986 pom = 1.0d0 - chis1 * chis2 * sqom12
23987 Lambf = (1.0d0 - (fac / pom))
23988 Lambf = dsqrt(Lambf)
23989 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23990 ! write (*,*) "sparrow = ", sparrow
23991 Chif = 1.0d0/rij * sparrow
23992 ChiLambf = Chif * Lambf
23993 eagle = dsqrt(ChiLambf)
23994 bat = ChiLambf ** 11.0d0
23995 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23996 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
24000 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
24001 dbot = 12.0d0 * b4 * bat * Lambf
24002 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24004 ! write (*,*) "dFcav/dR = ", dFdR
24005 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
24006 dbot = 12.0d0 * b4 * bat * Chif
24007 eagle = Lambf * pom
24008 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24009 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24010 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24011 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24013 dFdL = ((dtop * bot - top * dbot) / botsq)
24015 dCAVdOM1 = dFdL * ( dFdOM1 )
24016 dCAVdOM2 = dFdL * ( dFdOM2 )
24017 dCAVdOM12 = dFdL * ( dFdOM12 )
24022 ! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
24023 ! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
24024 ! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
24025 ! -2.0D0*alf12*eps3der+sigder*sigsq_om12
24026 ! print *,"EOMY",eom1,eom2,eom12
24027 ! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
24028 ! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
24030 ! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
24031 ! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24033 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24034 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24036 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24037 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
24038 - (( dFdR + gg(k) ) * pom)
24039 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24040 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24041 ! & - ( dFdR * pom )
24043 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24044 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
24045 + (( dFdR + gg(k) ) * pom)
24046 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24047 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24048 !c! & + ( dFdR * pom )
24050 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
24051 - (( dFdR + gg(k) ) * ertail(k))
24052 !c! & - ( dFdR * ertail(k))
24054 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
24055 + (( dFdR + gg(k) ) * ertail(k))
24056 !c! & + ( dFdR * ertail(k))
24059 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24060 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24067 if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
24068 w1 = wdipdip_scbase(1,itypi,itypj)
24069 w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
24070 w3 = wdipdip_scbase(2,itypi,itypj)
24071 !c!-------------------------------------------------------------------
24073 fac = (om12 - 3.0d0 * om1 * om2)
24074 c1 = (w1 / (Rhead**3.0d0)) * fac
24075 c2 = (w2 / Rhead ** 6.0d0) &
24076 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
24077 c3= (w3/ Rhead ** 6.0d0) &
24078 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24080 !c! write (*,*) "w1 = ", w1
24081 !c! write (*,*) "w2 = ", w2
24082 !c! write (*,*) "om1 = ", om1
24083 !c! write (*,*) "om2 = ", om2
24084 !c! write (*,*) "om12 = ", om12
24085 !c! write (*,*) "fac = ", fac
24086 !c! write (*,*) "c1 = ", c1
24087 !c! write (*,*) "c2 = ", c2
24088 !c! write (*,*) "Ecl = ", Ecl
24089 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
24090 !c! write (*,*) "c2_2 = ",
24091 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
24092 !c!-------------------------------------------------------------------
24093 !c! dervative of ECL is GCL...
24095 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
24096 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
24097 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
24098 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
24099 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24100 dGCLdR = c1 - c2 + c3
24102 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
24103 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24104 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
24105 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
24106 dGCLdOM1 = c1 - c2 + c3
24108 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
24109 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24110 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
24111 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
24112 dGCLdOM2 = c1 - c2 + c3
24114 c1 = w1 / (Rhead ** 3.0d0)
24115 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
24116 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
24117 dGCLdOM12 = c1 - c2 + c3
24119 erhead(k) = Rhead_distance(k)/Rhead
24121 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24122 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24123 facd1 = d1i * vbld_inv(i+nres)
24124 facd2 = d1j * vbld_inv(j+nres)
24127 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24128 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
24130 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24131 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
24134 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
24135 - dGCLdR * erhead(k)
24136 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
24137 + dGCLdR * erhead(k)
24140 !now charge with dipole eg. ARG-dG
24141 if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
24142 alphapol1 = alphapol_scbase(itypi,itypj)
24143 w1 = wqdip_scbase(1,itypi,itypj)
24144 w2 = wqdip_scbase(2,itypi,itypj)
24147 ! pis = sig0head_scbase(itypi,itypj)
24148 ! eps_head = epshead_scbase(itypi,itypj)
24149 !c!-------------------------------------------------------------------
24150 !c! R1 - distance between head of ith side chain and tail of jth sidechain
24153 !c! Calculate head-to-tail distances tail is center of side-chain
24154 R1=R1+(c(k,j+nres)-chead(k,1))**2
24159 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24160 !c! & +dhead(1,1,itypi,itypj))**2))
24161 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24162 !c! & +dhead(2,1,itypi,itypj))**2))
24164 !c!-------------------------------------------------------------------
24167 hawk = w2 * (1.0d0 - sqom2)
24168 Ecl = sparrow / Rhead**2.0d0 &
24169 - hawk / Rhead**4.0d0
24170 !c!-------------------------------------------------------------------
24171 !c! derivative of ecl is Gcl
24173 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
24174 + 4.0d0 * hawk / Rhead**5.0d0
24176 dGCLdOM1 = (w1) / (Rhead**2.0d0)
24178 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
24179 !c--------------------------------------------------------------------
24180 !c Polarization energy
24182 MomoFac1 = (1.0d0 - chi1 * sqom2)
24183 RR1 = R1 * R1 / MomoFac1
24184 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
24185 fgb1 = sqrt( RR1 + a12sq * ee1)
24186 ! eps_inout_fac=0.0d0
24187 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
24188 ! derivative of Epol is Gpol...
24189 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
24191 dFGBdR1 = ( (R1 / MomoFac1) &
24192 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
24194 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
24195 * (2.0d0 - 0.5d0 * ee1) ) &
24197 dPOLdR1 = dPOLdFGB1 * dFGBdR1
24200 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
24202 erhead(k) = Rhead_distance(k)/Rhead
24203 erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
24206 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24207 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24208 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
24210 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
24211 facd1 = d1i * vbld_inv(i+nres)
24212 facd2 = d1j * vbld_inv(j+nres)
24213 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24216 hawk = (erhead_tail(k,1) + &
24217 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
24220 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24221 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
24223 - dPOLdR1 * (erhead_tail(k,1))
24226 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24227 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
24229 + dPOLdR1 * (erhead_tail(k,1))
24233 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
24234 - dGCLdR * erhead(k) &
24235 - dPOLdR1 * erhead_tail(k,1)
24236 ! & - dGLJdR * erhead(k)
24238 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
24239 + dGCLdR * erhead(k) &
24240 + dPOLdR1 * erhead_tail(k,1)
24241 ! & + dGLJdR * erhead(k)
24245 ! print *,i,j,evdwij,epol,Fcav,ECL
24246 escbase=escbase+evdwij+epol+Fcav+ECL
24247 call sc_grad_scbase
24252 end subroutine eprot_sc_base
24253 SUBROUTINE sc_grad_scbase
24256 real (kind=8) :: dcosom1(3),dcosom2(3)
24258 eps2der * eps2rt_om1 &
24259 - 2.0D0 * alf1 * eps3der &
24260 + sigder * sigsq_om1 &
24266 eps2der * eps2rt_om2 &
24267 + 2.0D0 * alf2 * eps3der &
24268 + sigder * sigsq_om2 &
24274 evdwij * eps1_om12 &
24275 + eps2der * eps2rt_om12 &
24276 - 2.0D0 * alf12 * eps3der &
24277 + sigder *sigsq_om12 &
24281 ! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
24282 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
24283 ! gg(1),gg(2),"rozne"
24285 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
24286 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
24287 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
24288 gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
24289 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24290 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24291 gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
24292 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24293 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24294 gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
24295 gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
24298 END SUBROUTINE sc_grad_scbase
24301 subroutine epep_sc_base(epepbase)
24304 !el local variables
24305 integer :: iint,itypi,itypi1,itypj,subchap
24306 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
24307 real(kind=8) :: evdw,sig0ij
24308 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24309 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
24310 sslipi,sslipj,faclip
24312 real(kind=8) :: fracinbuf
24313 real (kind=8) :: epepbase
24314 real (kind=8),dimension(4):: ener
24315 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
24316 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
24317 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
24318 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
24319 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
24320 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
24321 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
24322 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
24323 real(kind=8),dimension(3,2)::chead,erhead_tail
24324 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
24328 ! do i=1,nres_molec(1)-1
24329 do i=ibond_start,ibond_end
24330 if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
24331 !C itypi = itype(i,1)
24335 ! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
24336 dsci_inv = vbld_inv(i+1)/2.0
24337 xi=(c(1,i)+c(1,i+1))/2.0
24338 yi=(c(2,i)+c(2,i+1))/2.0
24339 zi=(c(3,i)+c(3,i+1))/2.0
24340 call to_box(xi,yi,zi)
24341 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
24343 if (itype(j,2).eq.ntyp1_molec(2))cycle
24347 call to_box(xj,yj,zj)
24348 xj=boxshift(xj-xi,boxxsize)
24349 yj=boxshift(yj-yi,boxysize)
24350 zj=boxshift(zj-zi,boxzsize)
24351 dist_init=xj**2+yj**2+zj**2
24352 dxj = dc_norm( 1, nres+j )
24353 dyj = dc_norm( 2, nres+j )
24354 dzj = dc_norm( 3, nres+j )
24355 ! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
24356 ! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
24359 sig0ij = sigma_pepbase(itypj )
24360 chi1 = chi_pepbase(itypj,1 )
24361 chi2 = chi_pepbase(itypj,2 )
24364 chi12 = chi1 * chi2
24365 chip1 = chipp_pepbase(itypj,1 )
24366 chip2 = chipp_pepbase(itypj,2 )
24369 chip12 = chip1 * chip2
24370 chis1 = chis_pepbase(itypj,1)
24371 chis2 = chis_pepbase(itypj,2)
24372 chis12 = chis1 * chis2
24373 sig1 = sigmap1_pepbase(itypj)
24374 sig2 = sigmap2_pepbase(itypj)
24375 ! write (*,*) "sig1 = ", sig1
24376 ! write (*,*) "sig2 = ", sig2
24378 ! location of polar head is computed by taking hydrophobic centre
24379 ! and moving by a d1 * dc_norm vector
24380 ! see unres publications for very informative images
24381 chead(k,1) = (c(k,i)+c(k,i+1))/2.0
24382 ! + d1i * dc_norm(k, i+nres)
24383 chead(k,2) = c(k, j+nres)
24384 ! + d1j * dc_norm(k, j+nres)
24386 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
24387 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
24388 Rhead_distance(k) = chead(k,2) - chead(k,1)
24389 ! print *,gvdwc_pepbase(k,i)
24393 (Rhead_distance(1)*Rhead_distance(1)) &
24394 + (Rhead_distance(2)*Rhead_distance(2)) &
24395 + (Rhead_distance(3)*Rhead_distance(3)))
24397 ! alpha factors from Fcav/Gcav
24398 b1 = alphasur_pepbase(1,itypj)
24400 b2 = alphasur_pepbase(2,itypj)
24401 b3 = alphasur_pepbase(3,itypj)
24402 b4 = alphasur_pepbase(4,itypj)
24406 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24409 !----------------------------
24427 dscj_inv = vbld_inv(j+nres)
24429 ! this should be in elgrad_init but om's are calculated by sc_angular
24430 ! which in turn is used by older potentials
24431 ! om = omega, sqom = om^2
24434 sqom12 = om12 * om12
24436 ! now we calculate EGB - Gey-Berne
24437 ! It will be summed up in evdwij and saved in evdw
24438 sigsq = 1.0D0 / sigsq
24439 sig = sig0ij * dsqrt(sigsq)
24440 rij_shift = 1.0/rij - sig + sig0ij
24441 IF (rij_shift.le.0.0D0) THEN
24445 sigder = -sig * sigsq
24446 rij_shift = 1.0D0 / rij_shift
24447 fac = rij_shift**expon
24448 c1 = fac * fac * aa_pepbase(itypj)
24450 c2 = fac * bb_pepbase(itypj)
24452 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
24453 eps2der = eps3rt * evdwij
24454 eps3der = eps2rt * evdwij
24455 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
24456 evdwij = eps2rt * eps3rt * evdwij
24457 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
24458 fac = -expon * (c1 + evdwij) * rij_shift
24459 sigder = fac * sigder
24461 ! Calculate distance derivative
24465 fac = chis1 * sqom1 + chis2 * sqom2 &
24466 - 2.0d0 * chis12 * om1 * om2 * om12
24467 ! we will use pom later in Gcav, so dont mess with it!
24468 pom = 1.0d0 - chis1 * chis2 * sqom12
24469 Lambf = (1.0d0 - (fac / pom))
24470 Lambf = dsqrt(Lambf)
24471 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24472 ! write (*,*) "sparrow = ", sparrow
24473 Chif = 1.0d0/rij * sparrow
24474 ChiLambf = Chif * Lambf
24475 eagle = dsqrt(ChiLambf)
24476 bat = ChiLambf ** 11.0d0
24477 top = b1 * ( eagle + b2 * ChiLambf - b3 )
24478 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
24482 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
24483 dbot = 12.0d0 * b4 * bat * Lambf
24484 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24486 ! write (*,*) "dFcav/dR = ", dFdR
24487 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
24488 dbot = 12.0d0 * b4 * bat * Chif
24489 eagle = Lambf * pom
24490 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24491 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24492 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24493 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24495 dFdL = ((dtop * bot - top * dbot) / botsq)
24497 dCAVdOM1 = dFdL * ( dFdOM1 )
24498 dCAVdOM2 = dFdL * ( dFdOM2 )
24499 dCAVdOM12 = dFdL * ( dFdOM12 )
24505 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24506 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24508 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24509 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
24510 - (( dFdR + gg(k) ) * pom)/2.0
24511 ! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
24512 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24513 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24514 ! & - ( dFdR * pom )
24516 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24517 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
24518 + (( dFdR + gg(k) ) * pom)
24519 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24520 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24521 !c! & + ( dFdR * pom )
24523 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
24524 - (( dFdR + gg(k) ) * ertail(k))/2.0
24525 ! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
24527 !c! & - ( dFdR * ertail(k))
24529 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
24530 + (( dFdR + gg(k) ) * ertail(k))
24531 !c! & + ( dFdR * ertail(k))
24534 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24535 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24539 w1 = wdipdip_pepbase(1,itypj)
24540 w2 = -wdipdip_pepbase(3,itypj)/2.0
24541 w3 = wdipdip_pepbase(2,itypj)
24544 !c!-------------------------------------------------------------------
24547 fac = (om12 - 3.0d0 * om1 * om2)
24548 c1 = (w1 / (Rhead**3.0d0)) * fac
24549 c2 = (w2 / Rhead ** 6.0d0) &
24550 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
24551 c3= (w3/ Rhead ** 6.0d0) &
24552 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24556 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
24557 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
24558 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
24559 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
24560 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24562 dGCLdR = c1 - c2 + c3
24564 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
24565 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24566 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
24567 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
24568 dGCLdOM1 = c1 - c2 + c3
24570 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
24571 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24572 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
24573 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
24575 dGCLdOM2 = c1 - c2 + c3
24577 c1 = w1 / (Rhead ** 3.0d0)
24578 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
24579 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
24580 dGCLdOM12 = c1 - c2 + c3
24582 erhead(k) = Rhead_distance(k)/Rhead
24584 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24585 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24586 ! facd1 = d1 * vbld_inv(i+nres)
24587 ! facd2 = d2 * vbld_inv(j+nres)
24591 !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24592 ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
24595 !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24596 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
24599 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
24600 - dGCLdR * erhead(k)/2.0d0
24601 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
24602 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
24603 - dGCLdR * erhead(k)/2.0d0
24604 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
24605 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
24606 + dGCLdR * erhead(k)
24608 ! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
24609 epepbase=epepbase+evdwij+Fcav+ECL
24610 call sc_grad_pepbase
24613 END SUBROUTINE epep_sc_base
24614 SUBROUTINE sc_grad_pepbase
24617 real (kind=8) :: dcosom1(3),dcosom2(3)
24619 eps2der * eps2rt_om1 &
24620 - 2.0D0 * alf1 * eps3der &
24621 + sigder * sigsq_om1 &
24627 eps2der * eps2rt_om2 &
24628 + 2.0D0 * alf2 * eps3der &
24629 + sigder * sigsq_om2 &
24635 evdwij * eps1_om12 &
24636 + eps2der * eps2rt_om12 &
24637 - 2.0D0 * alf12 * eps3der &
24638 + sigder *sigsq_om12 &
24643 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
24644 ! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
24645 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
24647 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
24648 ! gg(1),gg(2),"rozne"
24650 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
24651 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
24652 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
24653 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
24654 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
24656 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24657 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
24658 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
24660 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24661 ! print *,eom12,eom2,om12,om2
24662 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
24663 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
24664 gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
24665 + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
24666 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24667 gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
24670 END SUBROUTINE sc_grad_pepbase
24671 subroutine eprot_sc_phosphate(escpho)
24673 ! implicit real*8 (a-h,o-z)
24674 ! include 'DIMENSIONS'
24675 ! include 'COMMON.GEO'
24676 ! include 'COMMON.VAR'
24677 ! include 'COMMON.LOCAL'
24678 ! include 'COMMON.CHAIN'
24679 ! include 'COMMON.DERIV'
24680 ! include 'COMMON.NAMES'
24681 ! include 'COMMON.INTERACT'
24682 ! include 'COMMON.IOUNITS'
24683 ! include 'COMMON.CALC'
24684 ! include 'COMMON.CONTROL'
24685 ! include 'COMMON.SBRIDGE'
24687 !el local variables
24688 integer :: iint,itypi,itypi1,itypj,subchap
24689 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
24690 real(kind=8) :: evdw,sig0ij,aa,bb
24691 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24692 dist_temp, dist_init,ssgradlipi,ssgradlipj, &
24693 sslipi,sslipj,faclip,alpha_sco
24695 real(kind=8) :: fracinbuf
24696 real (kind=8) :: escpho
24697 real (kind=8),dimension(4):: ener
24698 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
24699 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
24700 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
24701 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
24702 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
24703 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
24704 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
24705 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
24706 real(kind=8),dimension(3,2)::chead,erhead_tail
24707 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
24711 ! do i=1,nres_molec(1)
24712 do i=ibond_start,ibond_end
24713 if (itype(i,1).eq.ntyp1_molec(1)) cycle
24715 dxi = dc_norm(1,nres+i)
24716 dyi = dc_norm(2,nres+i)
24717 dzi = dc_norm(3,nres+i)
24718 dsci_inv = vbld_inv(i+nres)
24722 call to_box(xi,yi,zi)
24723 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
24724 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
24726 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
24727 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
24728 xj=(c(1,j)+c(1,j+1))/2.0
24729 yj=(c(2,j)+c(2,j+1))/2.0
24730 zj=(c(3,j)+c(3,j+1))/2.0
24731 call to_box(xj,yj,zj)
24732 ! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
24733 ! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
24734 ! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
24735 ! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
24736 ! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
24737 xj=boxshift(xj-xi,boxxsize)
24738 yj=boxshift(yj-yi,boxysize)
24739 zj=boxshift(zj-zi,boxzsize)
24740 dxj = dc_norm( 1,j )
24741 dyj = dc_norm( 2,j )
24742 dzj = dc_norm( 3,j )
24743 dscj_inv = vbld_inv(j+1)
24746 sig0ij = sigma_scpho(itypi )
24747 chi1 = chi_scpho(itypi,1 )
24748 chi2 = chi_scpho(itypi,2 )
24751 chi12 = chi1 * chi2
24752 chip1 = chipp_scpho(itypi,1 )
24753 chip2 = chipp_scpho(itypi,2 )
24756 chip12 = chip1 * chip2
24757 chis1 = chis_scpho(itypi,1)
24758 chis2 = chis_scpho(itypi,2)
24759 chis12 = chis1 * chis2
24760 sig1 = sigmap1_scpho(itypi)
24761 sig2 = sigmap2_scpho(itypi)
24762 ! write (*,*) "sig1 = ", sig1
24763 ! write (*,*) "sig1 = ", sig1
24764 ! write (*,*) "sig2 = ", sig2
24765 ! alpha factors from Fcav/Gcav
24769 a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
24771 b1 = alphasur_scpho(1,itypi)
24773 b2 = alphasur_scpho(2,itypi)
24774 b3 = alphasur_scpho(3,itypi)
24775 b4 = alphasur_scpho(4,itypi)
24776 ! used to determine whether we want to do quadrupole calculations
24778 eps_in = epsintab_scpho(itypi)
24779 if (eps_in.eq.0.0) eps_in=1.0
24780 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
24781 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
24782 !-------------------------------------------------------------------
24783 ! tail location and distance calculations
24784 d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
24787 ! location of polar head is computed by taking hydrophobic centre
24788 ! and moving by a d1 * dc_norm vector
24789 ! see unres publications for very informative images
24790 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
24791 chead(k,2) = (c(k, j) + c(k, j+1))/2.0
24793 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
24794 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
24795 Rhead_distance(k) = chead(k,2) - chead(k,1)
24797 ! pitagoras (root of sum of squares)
24799 (Rhead_distance(1)*Rhead_distance(1)) &
24800 + (Rhead_distance(2)*Rhead_distance(2)) &
24801 + (Rhead_distance(3)*Rhead_distance(3)))
24802 Rhead_sq=Rhead**2.0
24803 !-------------------------------------------------------------------
24804 ! zero everything that should be zero'ed
24823 dscj_inv = vbld_inv(j+1)/2.0
24824 !dhead_scbasej(itypi,itypj)
24825 ! print *,i,j,dscj_inv,dsci_inv
24826 ! rij holds 1/(distance of Calpha atoms)
24827 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24829 !----------------------------
24831 ! this should be in elgrad_init but om's are calculated by sc_angular
24832 ! which in turn is used by older potentials
24833 ! om = omega, sqom = om^2
24836 sqom12 = om12 * om12
24838 ! now we calculate EGB - Gey-Berne
24839 ! It will be summed up in evdwij and saved in evdw
24840 sigsq = 1.0D0 / sigsq
24841 sig = sig0ij * dsqrt(sigsq)
24842 ! rij_shift = 1.0D0 / rij - sig + sig0ij
24843 rij_shift = 1.0/rij - sig + sig0ij
24844 IF (rij_shift.le.0.0D0) THEN
24848 sigder = -sig * sigsq
24849 rij_shift = 1.0D0 / rij_shift
24850 fac = rij_shift**expon
24851 c1 = fac * fac * aa_scpho(itypi)
24853 c2 = fac * bb_scpho(itypi)
24855 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
24856 eps2der = eps3rt * evdwij
24857 eps3der = eps2rt * evdwij
24858 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
24859 evdwij = eps2rt * eps3rt * evdwij
24860 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
24861 fac = -expon * (c1 + evdwij) * rij_shift
24862 sigder = fac * sigder
24864 ! Calculate distance derivative
24868 fac = chis1 * sqom1 + chis2 * sqom2 &
24869 - 2.0d0 * chis12 * om1 * om2 * om12
24870 ! we will use pom later in Gcav, so dont mess with it!
24871 pom = 1.0d0 - chis1 * chis2 * sqom12
24872 Lambf = (1.0d0 - (fac / pom))
24873 Lambf = dsqrt(Lambf)
24874 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24875 ! write (*,*) "sparrow = ", sparrow
24876 Chif = 1.0d0/rij * sparrow
24877 ChiLambf = Chif * Lambf
24878 eagle = dsqrt(ChiLambf)
24879 bat = ChiLambf ** 11.0d0
24880 top = b1 * ( eagle + b2 * ChiLambf - b3 )
24881 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
24884 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
24885 dbot = 12.0d0 * b4 * bat * Lambf
24886 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24888 ! write (*,*) "dFcav/dR = ", dFdR
24889 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
24890 dbot = 12.0d0 * b4 * bat * Chif
24891 eagle = Lambf * pom
24892 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24893 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24894 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24895 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24897 dFdL = ((dtop * bot - top * dbot) / botsq)
24899 dCAVdOM1 = dFdL * ( dFdOM1 )
24900 dCAVdOM2 = dFdL * ( dFdOM2 )
24901 dCAVdOM12 = dFdL * ( dFdOM12 )
24907 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24908 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24909 ! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
24912 ! print *,pom,gg(k),dFdR
24913 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24914 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
24915 - (( dFdR + gg(k) ) * pom)
24916 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24917 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24918 ! & - ( dFdR * pom )
24920 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24921 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
24922 ! + (( dFdR + gg(k) ) * pom)
24923 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24924 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24925 !c! & + ( dFdR * pom )
24927 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
24928 - (( dFdR + gg(k) ) * ertail(k))
24929 !c! & - ( dFdR * ertail(k))
24931 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
24932 + (( dFdR + gg(k) ) * ertail(k))/2.0
24934 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
24935 + (( dFdR + gg(k) ) * ertail(k))/2.0
24937 !c! & + ( dFdR * ertail(k))
24941 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24942 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24943 ! alphapol1 = alphapol_scpho(itypi)
24944 if (wqq_scpho(itypi).ne.0.0) then
24945 Qij=wqq_scpho(itypi)/eps_in
24946 alpha_sco=1.d0/alphi_scpho(itypi)
24948 Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
24949 !c! derivative of Ecl is Gcl...
24950 dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
24951 (Rhead*alpha_sco+1) ) / Rhead_sq
24952 if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
24953 else if (wqdip_scpho(2,itypi).gt.0.0d0) then
24954 w1 = wqdip_scpho(1,itypi)
24955 w2 = wqdip_scpho(2,itypi)
24958 ! pis = sig0head_scbase(itypi,itypj)
24959 ! eps_head = epshead_scbase(itypi,itypj)
24960 !c!-------------------------------------------------------------------
24962 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24963 !c! & +dhead(1,1,itypi,itypj))**2))
24964 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24965 !c! & +dhead(2,1,itypi,itypj))**2))
24967 !c!-------------------------------------------------------------------
24970 hawk = w2 * (1.0d0 - sqom2)
24971 Ecl = sparrow / Rhead**2.0d0 &
24972 - hawk / Rhead**4.0d0
24973 !c!-------------------------------------------------------------------
24974 if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
24977 !c! derivative of ecl is Gcl
24979 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
24980 + 4.0d0 * hawk / Rhead**5.0d0
24982 dGCLdOM1 = (w1) / (Rhead**2.0d0)
24984 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
24987 !c--------------------------------------------------------------------
24988 !c Polarization energy
24992 !c! Calculate head-to-tail distances tail is center of side-chain
24993 R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
24998 alphapol1 = alphapol_scpho(itypi)
25000 MomoFac1 = (1.0d0 - chi2 * sqom1)
25001 RR1 = R1 * R1 / MomoFac1
25002 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25003 ! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
25004 fgb1 = sqrt( RR1 + a12sq * ee1)
25005 ! eps_inout_fac=0.0d0
25006 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
25007 ! derivative of Epol is Gpol...
25008 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
25010 dFGBdR1 = ( (R1 / MomoFac1) &
25011 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
25013 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
25014 * (2.0d0 - 0.5d0 * ee1) ) &
25016 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25019 dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
25020 * (2.0d0 - 0.5d0 * ee1) ) &
25023 dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
25026 erhead(k) = Rhead_distance(k)/Rhead
25027 erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
25030 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25031 erdxj = scalar( erhead(1), dC_norm(1,j) )
25032 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25034 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
25035 facd1 = d1i * vbld_inv(i+nres)
25036 facd2 = d1j * vbld_inv(j)
25037 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25040 hawk = (erhead_tail(k,1) + &
25041 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
25044 ! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
25045 ! pom,(erhead_tail(k,1))
25047 ! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
25048 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25049 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
25051 - dPOLdR1 * (erhead_tail(k,1))
25054 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
25055 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
25057 ! + dPOLdR1 * (erhead_tail(k,1))
25061 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
25062 - dGCLdR * erhead(k) &
25063 - dPOLdR1 * erhead_tail(k,1)
25064 ! & - dGLJdR * erhead(k)
25066 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
25067 + (dGCLdR * erhead(k) &
25068 + dPOLdR1 * erhead_tail(k,1))/2.0
25069 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
25070 + (dGCLdR * erhead(k) &
25071 + dPOLdR1 * erhead_tail(k,1))/2.0
25073 ! & + dGLJdR * erhead(k)
25074 ! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
25077 ! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
25078 if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
25079 "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
25080 escpho=escpho+evdwij+epol+Fcav+ECL
25087 end subroutine eprot_sc_phosphate
25088 SUBROUTINE sc_grad_scpho
25091 real (kind=8) :: dcosom1(3),dcosom2(3)
25093 eps2der * eps2rt_om1 &
25094 - 2.0D0 * alf1 * eps3der &
25095 + sigder * sigsq_om1 &
25101 eps2der * eps2rt_om2 &
25102 + 2.0D0 * alf2 * eps3der &
25103 + sigder * sigsq_om2 &
25109 evdwij * eps1_om12 &
25110 + eps2der * eps2rt_om12 &
25111 - 2.0D0 * alf12 * eps3der &
25112 + sigder *sigsq_om12 &
25117 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
25118 ! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),&
25119 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
25121 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
25122 ! gg(1),gg(2),"rozne"
25124 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
25125 dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
25126 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
25127 gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
25128 + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
25130 - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25131 gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
25132 - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
25134 + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25135 gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
25136 + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
25137 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
25139 ! print *,eom12,eom2,om12,om2
25140 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
25141 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
25142 ! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
25143 ! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
25144 ! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25145 gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
25148 END SUBROUTINE sc_grad_scpho
25149 subroutine eprot_pep_phosphate(epeppho)
25151 ! implicit real*8 (a-h,o-z)
25152 ! include 'DIMENSIONS'
25153 ! include 'COMMON.GEO'
25154 ! include 'COMMON.VAR'
25155 ! include 'COMMON.LOCAL'
25156 ! include 'COMMON.CHAIN'
25157 ! include 'COMMON.DERIV'
25158 ! include 'COMMON.NAMES'
25159 ! include 'COMMON.INTERACT'
25160 ! include 'COMMON.IOUNITS'
25161 ! include 'COMMON.CALC'
25162 ! include 'COMMON.CONTROL'
25163 ! include 'COMMON.SBRIDGE'
25165 !el local variables
25166 integer :: iint,itypi,itypi1,itypj,subchap
25167 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
25168 real(kind=8) :: evdw,sig0ij
25169 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
25170 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
25171 sslipi,sslipj,faclip
25173 real(kind=8) :: fracinbuf
25174 real (kind=8) :: epeppho
25175 real (kind=8),dimension(4):: ener
25176 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
25177 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
25178 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
25179 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
25180 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
25181 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
25182 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
25183 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
25184 real(kind=8),dimension(3,2)::chead,erhead_tail
25185 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
25187 real (kind=8) :: dcosom1(3),dcosom2(3)
25189 ! do i=1,nres_molec(1)
25190 do i=ibond_start,ibond_end
25191 if (itype(i,1).eq.ntyp1_molec(1)) cycle
25193 dsci_inv = vbld_inv(i+1)/2.0
25197 xi=(c(1,i)+c(1,i+1))/2.0
25198 yi=(c(2,i)+c(2,i+1))/2.0
25199 zi=(c(3,i)+c(3,i+1))/2.0
25200 call to_box(xi,yi,zi)
25202 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
25204 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
25205 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
25206 xj=(c(1,j)+c(1,j+1))/2.0
25207 yj=(c(2,j)+c(2,j+1))/2.0
25208 zj=(c(3,j)+c(3,j+1))/2.0
25209 call to_box(xj,yj,zj)
25210 xj=boxshift(xj-xi,boxxsize)
25211 yj=boxshift(yj-yi,boxysize)
25212 zj=boxshift(zj-zi,boxzsize)
25214 dist_init=xj**2+yj**2+zj**2
25215 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
25217 dxj = dc_norm( 1,j )
25218 dyj = dc_norm( 2,j )
25219 dzj = dc_norm( 3,j )
25220 dscj_inv = vbld_inv(j+1)/2.0
25222 sig0ij = sigma_peppho
25225 chi12 = chi1 * chi2
25228 chip12 = chip1 * chip2
25231 chis12 = chis1 * chis2
25232 sig1 = sigmap1_peppho
25233 sig2 = sigmap2_peppho
25234 ! write (*,*) "sig1 = ", sig1
25235 ! write (*,*) "sig1 = ", sig1
25236 ! write (*,*) "sig2 = ", sig2
25237 ! alpha factors from Fcav/Gcav
25241 b1 = alphasur_peppho(1)
25243 b2 = alphasur_peppho(2)
25244 b3 = alphasur_peppho(3)
25245 b4 = alphasur_peppho(4)
25267 fac = rij_shift**expon
25268 c1 = fac * fac * aa_peppho
25270 c2 = fac * bb_peppho
25273 ! Now cavity....................
25274 eagle = dsqrt(1.0/rij_shift)
25275 top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
25276 bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
25279 dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
25280 dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
25281 dFdR = ((dtop * bot - top * dbot) / botsq)
25282 w1 = wqdip_peppho(1)
25283 w2 = wqdip_peppho(2)
25286 ! pis = sig0head_scbase(itypi,itypj)
25287 ! eps_head = epshead_scbase(itypi,itypj)
25288 !c!-------------------------------------------------------------------
25290 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25291 !c! & +dhead(1,1,itypi,itypj))**2))
25292 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25293 !c! & +dhead(2,1,itypi,itypj))**2))
25295 !c!-------------------------------------------------------------------
25298 hawk = w2 * (1.0d0 - sqom1)
25299 Ecl = sparrow * rij_shift**2.0d0 &
25300 - hawk * rij_shift**4.0d0
25301 !c!-------------------------------------------------------------------
25302 !c! derivative of ecl is Gcl
25305 dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
25306 + 4.0d0 * hawk * rij_shift**5.0d0
25308 dGCLdOM1 = (w1) * (rij_shift**2.0d0)
25310 dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
25311 eom1 = dGCLdOM1+dGCLdOM2
25314 fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
25320 gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
25321 gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
25322 gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
25323 gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
25328 dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
25329 dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
25330 gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
25331 gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
25332 ! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25333 gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
25334 ! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25335 gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
25336 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
25337 gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
25338 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
25340 epeppho=epeppho+evdwij+Fcav+ECL
25341 ! print *,i,j,evdwij,Fcav,ECL,rij_shift
25344 end subroutine eprot_pep_phosphate
25345 !!!!!!!!!!!!!!!!-------------------------------------------------------------
25346 subroutine emomo(evdw)
25349 ! implicit real*8 (a-h,o-z)
25350 ! include 'DIMENSIONS'
25351 ! include 'COMMON.GEO'
25352 ! include 'COMMON.VAR'
25353 ! include 'COMMON.LOCAL'
25354 ! include 'COMMON.CHAIN'
25355 ! include 'COMMON.DERIV'
25356 ! include 'COMMON.NAMES'
25357 ! include 'COMMON.INTERACT'
25358 ! include 'COMMON.IOUNITS'
25359 ! include 'COMMON.CALC'
25360 ! include 'COMMON.CONTROL'
25361 ! include 'COMMON.SBRIDGE'
25363 !el local variables
25364 integer :: iint,itypi1,subchap,isel
25365 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
25366 real(kind=8) :: evdw,aa,bb
25367 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
25368 dist_temp, dist_init,ssgradlipi,ssgradlipj, &
25369 sslipi,sslipj,faclip,alpha_sco
25371 real(kind=8) :: fracinbuf
25372 real (kind=8) :: escpho
25373 real (kind=8),dimension(4):: ener
25374 real(kind=8) :: b1,b2,egb
25375 real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
25377 Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
25378 dFdOM2,dFdL,dFdOM12,&
25381 ! real(kind=8),dimension(3,2)::erhead_tail
25382 ! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
25383 real(kind=8) :: facd4, adler, Fgb, facd3
25384 integer troll,jj,istate
25385 real (kind=8) :: dcosom1(3),dcosom2(3)
25389 ! print *,"EVDW KURW",evdw,nres
25390 do i=iatsc_s,iatsc_e
25391 ! print *,"I am in EVDW",i
25392 itypi=iabs(itype(i,1))
25393 ! if (i.ne.47) cycle
25394 if (itypi.eq.ntyp1) cycle
25395 itypi1=iabs(itype(i+1,1))
25399 call to_box(xi,yi,zi)
25400 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
25402 ! print *, sslipi,ssgradlipi
25403 dxi=dc_norm(1,nres+i)
25404 dyi=dc_norm(2,nres+i)
25405 dzi=dc_norm(3,nres+i)
25406 ! dsci_inv=dsc_inv(itypi)
25407 dsci_inv=vbld_inv(i+nres)
25408 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
25409 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
25411 ! Calculate SC interaction energy.
25413 do iint=1,nint_gr(i)
25414 do j=istart(i,iint),iend(i,iint)
25415 ! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint)
25416 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
25417 call dyn_ssbond_ene(i,j,evdwij)
25419 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
25420 'evdw',i,j,evdwij,' ss'
25421 ! if (energy_dec) write (iout,*) &
25422 ! 'evdw',i,j,evdwij,' ss'
25423 do k=j+1,iend(i,iint)
25424 !C search over all next residues
25425 if (dyn_ss_mask(k)) then
25426 !C check if they are cysteins
25427 !C write(iout,*) 'k=',k
25429 !c write(iout,*) "PRZED TRI", evdwij
25430 ! evdwij_przed_tri=evdwij
25431 call triple_ssbond_ene(i,j,k,evdwij)
25432 !c if(evdwij_przed_tri.ne.evdwij) then
25433 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
25436 !c write(iout,*) "PO TRI", evdwij
25437 !C call the energy function that removes the artifical triple disulfide
25438 !C bond the soubroutine is located in ssMD.F
25440 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
25441 'evdw',i,j,evdwij,'tss'
25442 endif!dyn_ss_mask(k)
25446 itypj=iabs(itype(j,1))
25447 if (itypj.eq.ntyp1) cycle
25448 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
25450 ! if (j.ne.78) cycle
25451 ! dscj_inv=dsc_inv(itypj)
25452 dscj_inv=vbld_inv(j+nres)
25456 call to_box(xj,yj,zj)
25457 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
25458 ! write(iout,*) "KRUWA", i,j
25459 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
25460 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
25461 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
25462 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
25463 xj=boxshift(xj-xi,boxxsize)
25464 yj=boxshift(yj-yi,boxysize)
25465 zj=boxshift(zj-zi,boxzsize)
25466 dxj = dc_norm( 1, nres+j )
25467 dyj = dc_norm( 2, nres+j )
25468 dzj = dc_norm( 3, nres+j )
25469 ! print *,i,j,itypi,itypj
25472 ! BetaT = 1.0d0 / (298.0d0 * Rb)
25474 !1! sig0ij = sigma_scsc( itypi,itypj )
25479 ! not used by momo potential, but needed by sc_angular which is shared
25480 ! by all energy_potential subroutines
25484 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
25485 ! a12sq = a12sq * a12sq
25486 ! charge of amino acid itypi is...
25487 chis1 = chis(itypi,itypj)
25488 chis2 = chis(itypj,itypi)
25489 chis12 = chis1 * chis2
25490 sig1 = sigmap1(itypi,itypj)
25491 sig2 = sigmap2(itypi,itypj)
25492 ! write (*,*) "sig1 = ", sig1
25495 ! chis12 = chis1 * chis2
25498 ! write (*,*) "sig2 = ", sig2
25499 ! alpha factors from Fcav/Gcav
25500 b1cav = alphasur(1,itypi,itypj)
25502 b2cav = alphasur(2,itypi,itypj)
25503 b3cav = alphasur(3,itypi,itypj)
25504 b4cav = alphasur(4,itypi,itypj)
25505 ! used to determine whether we want to do quadrupole calculations
25506 eps_in = epsintab(itypi,itypj)
25507 if (eps_in.eq.0.0) eps_in=1.0
25509 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
25511 ! dtail(1,itypi,itypj)=0.0
25512 ! dtail(2,itypi,itypj)=0.0
25515 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
25516 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
25518 !c! tail distances will be themselves usefull elswhere
25519 !c1 (in Gcav, for example)
25520 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
25521 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
25522 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
25524 (Rtail_distance(1)*Rtail_distance(1)) &
25525 + (Rtail_distance(2)*Rtail_distance(2)) &
25526 + (Rtail_distance(3)*Rtail_distance(3)))
25528 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
25529 !-------------------------------------------------------------------
25530 ! tail location and distance calculations
25531 d1 = dhead(1, 1, itypi, itypj)
25532 d2 = dhead(2, 1, itypi, itypj)
25535 ! location of polar head is computed by taking hydrophobic centre
25536 ! and moving by a d1 * dc_norm vector
25537 ! see unres publications for very informative images
25538 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
25539 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
25541 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
25542 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
25543 Rhead_distance(k) = chead(k,2) - chead(k,1)
25545 ! pitagoras (root of sum of squares)
25547 (Rhead_distance(1)*Rhead_distance(1)) &
25548 + (Rhead_distance(2)*Rhead_distance(2)) &
25549 + (Rhead_distance(3)*Rhead_distance(3)))
25550 !-------------------------------------------------------------------
25551 ! zero everything that should be zero'ed
25569 dscj_inv = vbld_inv(j+nres)
25570 ! print *,i,j,dscj_inv,dsci_inv
25571 ! rij holds 1/(distance of Calpha atoms)
25572 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
25574 !----------------------------
25576 ! this should be in elgrad_init but om's are calculated by sc_angular
25577 ! which in turn is used by older potentials
25578 ! om = omega, sqom = om^2
25581 sqom12 = om12 * om12
25583 ! now we calculate EGB - Gey-Berne
25584 ! It will be summed up in evdwij and saved in evdw
25585 sigsq = 1.0D0 / sigsq
25586 sig = sig0ij * dsqrt(sigsq)
25587 ! rij_shift = 1.0D0 / rij - sig + sig0ij
25588 rij_shift = Rtail - sig + sig0ij
25589 IF (rij_shift.le.0.0D0) THEN
25593 sigder = -sig * sigsq
25594 rij_shift = 1.0D0 / rij_shift
25595 fac = rij_shift**expon
25596 c1 = fac * fac * aa_aq(itypi,itypj)
25597 ! print *,"ADAM",aa_aq(itypi,itypj)
25600 c2 = fac * bb_aq(itypi,itypj)
25602 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
25603 eps2der = eps3rt * evdwij
25604 eps3der = eps2rt * evdwij
25605 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
25606 evdwij = eps2rt * eps3rt * evdwij
25608 ! IF (bb_aq(itypi,itypj).gt.0) THEN
25609 ! evdw_p = evdw_p + evdwij
25611 ! evdw_m = evdw_m + evdwij
25618 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
25619 fac = -expon * (c1 + evdwij) * rij_shift
25620 sigder = fac * sigder
25622 ! Calculate distance derivative
25626 ! if (b2.gt.0.0) then
25627 fac = chis1 * sqom1 + chis2 * sqom2 &
25628 - 2.0d0 * chis12 * om1 * om2 * om12
25629 ! we will use pom later in Gcav, so dont mess with it!
25630 pom = 1.0d0 - chis1 * chis2 * sqom12
25631 Lambf = (1.0d0 - (fac / pom))
25632 ! print *,"fac,pom",fac,pom,Lambf
25633 Lambf = dsqrt(Lambf)
25634 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
25635 ! print *,"sig1,sig2",sig1,sig2,itypi,itypj
25636 ! write (*,*) "sparrow = ", sparrow
25637 Chif = Rtail * sparrow
25638 ! print *,"rij,sparrow",rij , sparrow
25639 ChiLambf = Chif * Lambf
25640 eagle = dsqrt(ChiLambf)
25641 bat = ChiLambf ** 11.0d0
25642 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
25643 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
25645 ! print *,top,bot,"bot,top",ChiLambf,Chif
25648 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
25649 dbot = 12.0d0 * b4cav * bat * Lambf
25650 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
25652 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
25653 dbot = 12.0d0 * b4cav * bat * Chif
25654 eagle = Lambf * pom
25655 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
25656 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
25657 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
25658 * (chis2 * om2 * om12 - om1) / (eagle * pom)
25660 dFdL = ((dtop * bot - top * dbot) / botsq)
25662 dCAVdOM1 = dFdL * ( dFdOM1 )
25663 dCAVdOM2 = dFdL * ( dFdOM2 )
25664 dCAVdOM12 = dFdL * ( dFdOM12 )
25667 ertail(k) = Rtail_distance(k)/Rtail
25669 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
25670 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
25671 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25672 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25674 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
25675 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
25676 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
25677 gvdwx(k,i) = gvdwx(k,i) &
25678 - (( dFdR + gg(k) ) * pom)
25679 !c! & - ( dFdR * pom )
25680 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
25681 gvdwx(k,j) = gvdwx(k,j) &
25682 + (( dFdR + gg(k) ) * pom)
25683 !c! & + ( dFdR * pom )
25685 gvdwc(k,i) = gvdwc(k,i) &
25686 - (( dFdR + gg(k) ) * ertail(k))
25687 !c! & - ( dFdR * ertail(k))
25689 gvdwc(k,j) = gvdwc(k,j) &
25690 + (( dFdR + gg(k) ) * ertail(k))
25691 !c! & + ( dFdR * ertail(k))
25694 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
25695 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
25699 !c! Compute head-head and head-tail energies for each state
25701 isel = iabs(Qi) + iabs(Qj)
25702 ! double charge for Phophorylated! itype - 25,27,27
25703 ! if ((itype(i).eq.27).or.(itype(i).eq.26).or.(itype(i).eq.25)) then
25707 ! if ((itype(j).eq.27).or.(itype(j).eq.26).or.(itype(j).eq.25)) then
25713 IF (isel.eq.0) THEN
25714 !c! No charges - do nothing
25717 ELSE IF (isel.eq.4) THEN
25718 !c! Calculate dipole-dipole interactions
25721 ! eheadtail = 0.0d0
25723 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
25724 !c! Charge-nonpolar interactions
25725 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25729 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25736 ! eheadtail = 0.0d0
25738 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
25739 !c! Nonpolar-charge interactions
25740 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25744 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25751 ! eheadtail = 0.0d0
25753 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
25754 !c! Charge-dipole interactions
25755 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25759 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25764 CALL eqd(ecl, elj, epol)
25765 eheadtail = ECL + elj + epol
25766 ! eheadtail = 0.0d0
25768 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
25769 !c! Dipole-charge interactions
25770 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25774 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25778 CALL edq(ecl, elj, epol)
25779 eheadtail = ECL + elj + epol
25780 ! eheadtail = 0.0d0
25782 ELSE IF ((isel.eq.2.and. &
25783 iabs(Qi).eq.1).and. &
25784 nstate(itypi,itypj).eq.1) THEN
25785 !c! Same charge-charge interaction ( +/+ or -/- )
25786 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25790 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25795 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
25796 eheadtail = ECL + Egb + Epol + Fisocav + Elj
25797 ! eheadtail = 0.0d0
25799 ELSE IF ((isel.eq.2.and. &
25800 iabs(Qi).eq.1).and. &
25801 nstate(itypi,itypj).ne.1) THEN
25802 !c! Different charge-charge interaction ( +/- or -/+ )
25803 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25807 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25812 CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
25814 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
25815 evdw = evdw + Fcav + eheadtail
25817 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
25818 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
25819 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
25820 Equad,evdwij+Fcav+eheadtail,evdw
25821 ! evdw = evdw + Fcav + eheadtail
25823 iF (nstate(itypi,itypj).eq.1) THEN
25826 !c!-------------------------------------------------------------------
25831 !c write (iout,*) "Number of loop steps in EGB:",ind
25832 !c energy_dec=.false.
25833 ! print *,"EVDW KURW",evdw,nres
25836 END SUBROUTINE emomo
25837 !C------------------------------------------------------------------------------------
25838 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
25841 real (kind=8) :: facd3, facd4, federmaus, adler,&
25842 Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
25844 !c! Epol and Gpol analytical parameters
25845 alphapol1 = alphapol(itypi,itypj)
25846 alphapol2 = alphapol(itypj,itypi)
25847 !c! Fisocav and Gisocav analytical parameters
25848 al1 = alphiso(1,itypi,itypj)
25849 al2 = alphiso(2,itypi,itypj)
25850 al3 = alphiso(3,itypi,itypj)
25851 al4 = alphiso(4,itypi,itypj)
25853 / dsqrt(sigiso1(itypi, itypj)**2.0d0 &
25854 + sigiso2(itypi,itypj)**2.0d0))
25856 pis = sig0head(itypi,itypj)
25857 eps_head = epshead(itypi,itypj)
25858 Rhead_sq = Rhead * Rhead
25859 !c! R1 - distance between head of ith side chain and tail of jth sidechain
25860 !c! R2 - distance between head of jth side chain and tail of ith sidechain
25864 !c! Calculate head-to-tail distances needed by Epol
25865 R1=R1+(ctail(k,2)-chead(k,1))**2
25866 R2=R2+(chead(k,2)-ctail(k,1))**2
25872 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25873 !c! & +dhead(1,1,itypi,itypj))**2))
25874 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25875 !c! & +dhead(2,1,itypi,itypj))**2))
25877 !c!-------------------------------------------------------------------
25878 !c! Coulomb electrostatic interaction
25879 Ecl = (332.0d0 * Qij) / Rhead
25880 !c! derivative of Ecl is Gcl...
25881 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
25885 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
25886 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
25887 debkap=debaykap(itypi,itypj)
25888 Egb = -(332.0d0 * Qij *&
25889 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
25890 ! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
25891 !c! Derivative of Egb is Ggb...
25892 dGGBdFGB = -(-332.0d0 * Qij * &
25893 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
25895 (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
25896 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
25897 dGGBdR = dGGBdFGB * dFGBdR
25898 !c!-------------------------------------------------------------------
25899 !c! Fisocav - isotropic cavity creation term
25900 !c! or "how much energy it costs to put charged head in water"
25902 top = al1 * (dsqrt(pom) + al2 * pom - al3)
25903 bot = (1.0d0 + al4 * pom**12.0d0)
25905 FisoCav = top / bot
25906 ! write (*,*) "Rhead = ",Rhead
25907 ! write (*,*) "csig = ",csig
25908 ! write (*,*) "pom = ",pom
25909 ! write (*,*) "al1 = ",al1
25910 ! write (*,*) "al2 = ",al2
25911 ! write (*,*) "al3 = ",al3
25912 ! write (*,*) "al4 = ",al4
25913 ! write (*,*) "top = ",top
25914 ! write (*,*) "bot = ",bot
25915 !c! Derivative of Fisocav is GCV...
25916 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
25917 dbot = 12.0d0 * al4 * pom ** 11.0d0
25918 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
25919 !c!-------------------------------------------------------------------
25921 !c! Polarization energy - charged heads polarize hydrophobic "neck"
25922 MomoFac1 = (1.0d0 - chi1 * sqom2)
25923 MomoFac2 = (1.0d0 - chi2 * sqom1)
25924 RR1 = ( R1 * R1 ) / MomoFac1
25925 RR2 = ( R2 * R2 ) / MomoFac2
25926 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25927 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
25928 fgb1 = sqrt( RR1 + a12sq * ee1 )
25929 fgb2 = sqrt( RR2 + a12sq * ee2 )
25930 epol = 332.0d0 * eps_inout_fac * ( &
25931 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
25933 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
25935 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
25937 dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
25939 dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
25941 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
25942 * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
25943 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
25944 * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
25945 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25946 !c! dPOLdR1 = 0.0d0
25947 dPOLdR2 = dPOLdFGB2 * dFGBdR2
25948 !c! dPOLdR2 = 0.0d0
25949 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
25950 !c! dPOLdOM1 = 0.0d0
25951 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
25952 !c! dPOLdOM2 = 0.0d0
25953 !c!-------------------------------------------------------------------
25955 !c! Lennard-Jones 6-12 interaction between heads
25956 pom = (pis / Rhead)**6.0d0
25957 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
25958 !c! derivative of Elj is Glj
25959 dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
25960 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
25961 !c!-------------------------------------------------------------------
25962 !c! Return the results
25963 !c! These things do the dRdX derivatives, that is
25964 !c! allow us to change what we see from function that changes with
25965 !c! distance to function that changes with LOCATION (of the interaction
25968 erhead(k) = Rhead_distance(k)/Rhead
25969 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
25970 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
25973 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25974 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
25975 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25976 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
25977 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
25978 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
25979 facd1 = d1 * vbld_inv(i+nres)
25980 facd2 = d2 * vbld_inv(j+nres)
25981 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25982 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25984 !c! Now we add appropriate partial derivatives (one in each dimension)
25986 hawk = (erhead_tail(k,1) + &
25987 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
25988 condor = (erhead_tail(k,2) + &
25989 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
25991 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25992 gvdwx(k,i) = gvdwx(k,i) &
25997 - dPOLdR2 * (erhead_tail(k,2)&
25998 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
26001 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26002 gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom&
26003 + dGGBdR * pom+ dGCVdR * pom&
26004 + dPOLdR1 * (erhead_tail(k,1)&
26005 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
26006 + dPOLdR2 * condor + dGLJdR * pom
26008 gvdwc(k,i) = gvdwc(k,i) &
26009 - dGCLdR * erhead(k)&
26010 - dGGBdR * erhead(k)&
26011 - dGCVdR * erhead(k)&
26012 - dPOLdR1 * erhead_tail(k,1)&
26013 - dPOLdR2 * erhead_tail(k,2)&
26014 - dGLJdR * erhead(k)
26016 gvdwc(k,j) = gvdwc(k,j) &
26017 + dGCLdR * erhead(k) &
26018 + dGGBdR * erhead(k) &
26019 + dGCVdR * erhead(k) &
26020 + dPOLdR1 * erhead_tail(k,1) &
26021 + dPOLdR2 * erhead_tail(k,2)&
26022 + dGLJdR * erhead(k)
26028 SUBROUTINE eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
26031 real (kind=8) :: facd3, facd4, federmaus, adler,&
26032 Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
26034 !c! Epol and Gpol analytical parameters
26035 alphapol1 = alphapolcat(itypi,itypj)
26036 alphapol2 = alphapolcat2(itypj,itypi)
26037 !c! Fisocav and Gisocav analytical parameters
26038 al1 = alphisocat(1,itypi,itypj)
26039 al2 = alphisocat(2,itypi,itypj)
26040 al3 = alphisocat(3,itypi,itypj)
26041 al4 = alphisocat(4,itypi,itypj)
26043 / dsqrt(sigiso1cat(itypi, itypj)**2.0d0 &
26044 + sigiso2cat(itypi,itypj)**2.0d0))
26046 pis = sig0headcat(itypi,itypj)
26047 eps_head = epsheadcat(itypi,itypj)
26048 Rhead_sq = Rhead * Rhead
26049 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26050 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26054 !c! Calculate head-to-tail distances needed by Epol
26055 R1=R1+(ctail(k,2)-chead(k,1))**2
26056 R2=R2+(chead(k,2)-ctail(k,1))**2
26062 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26063 !c! & +dhead(1,1,itypi,itypj))**2))
26064 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26065 !c! & +dhead(2,1,itypi,itypj))**2))
26067 !c!-------------------------------------------------------------------
26068 !c! Coulomb electrostatic interaction
26069 Ecl = (332.0d0 * Qij) / Rhead
26070 !c! derivative of Ecl is Gcl...
26071 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
26075 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
26076 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
26077 debkap=debaykapcat(itypi,itypj)
26078 Egb = -(332.0d0 * Qij *&
26079 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
26080 ! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
26081 !c! Derivative of Egb is Ggb...
26082 dGGBdFGB = -(-332.0d0 * Qij * &
26083 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
26085 (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
26086 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
26087 dGGBdR = dGGBdFGB * dFGBdR
26088 !c!-------------------------------------------------------------------
26089 !c! Fisocav - isotropic cavity creation term
26090 !c! or "how much energy it costs to put charged head in water"
26092 top = al1 * (dsqrt(pom) + al2 * pom - al3)
26093 bot = (1.0d0 + al4 * pom**12.0d0)
26095 FisoCav = top / bot
26096 ! write (*,*) "Rhead = ",Rhead
26097 ! write (*,*) "csig = ",csig
26098 ! write (*,*) "pom = ",pom
26099 ! write (*,*) "al1 = ",al1
26100 ! write (*,*) "al2 = ",al2
26101 ! write (*,*) "al3 = ",al3
26102 ! write (*,*) "al4 = ",al4
26103 ! write (*,*) "top = ",top
26104 ! write (*,*) "bot = ",bot
26105 !c! Derivative of Fisocav is GCV...
26106 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
26107 dbot = 12.0d0 * al4 * pom ** 11.0d0
26108 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
26109 !c!-------------------------------------------------------------------
26111 !c! Polarization energy - charged heads polarize hydrophobic "neck"
26112 MomoFac1 = (1.0d0 - chi1 * sqom2)
26113 MomoFac2 = (1.0d0 - chi2 * sqom1)
26114 RR1 = ( R1 * R1 ) / MomoFac1
26115 RR2 = ( R2 * R2 ) / MomoFac2
26116 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26117 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
26118 fgb1 = sqrt( RR1 + a12sq * ee1 )
26119 fgb2 = sqrt( RR2 + a12sq * ee2 )
26120 epol = 332.0d0 * eps_inout_fac * ( &
26121 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
26123 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
26125 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
26127 dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
26129 dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
26131 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
26132 * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
26133 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
26134 * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
26135 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26136 !c! dPOLdR1 = 0.0d0
26137 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26138 !c! dPOLdR2 = 0.0d0
26139 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26140 !c! dPOLdOM1 = 0.0d0
26141 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26142 !c! dPOLdOM2 = 0.0d0
26143 !c!-------------------------------------------------------------------
26145 !c! Lennard-Jones 6-12 interaction between heads
26146 pom = (pis / Rhead)**6.0d0
26147 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26148 !c! derivative of Elj is Glj
26149 dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
26150 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26151 !c!-------------------------------------------------------------------
26152 !c! Return the results
26153 !c! These things do the dRdX derivatives, that is
26154 !c! allow us to change what we see from function that changes with
26155 !c! distance to function that changes with LOCATION (of the interaction
26158 erhead(k) = Rhead_distance(k)/Rhead
26159 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26160 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26163 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26164 erdxj = scalar( erhead(1), dC_norm(1,j) )
26165 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26166 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
26167 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
26168 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26169 facd1 = d1 * vbld_inv(i+nres)
26170 facd2 = d2 * vbld_inv(j)
26171 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
26172 facd4 = dtailcat(2,itypi,itypj) * vbld_inv(j)
26174 !c! Now we add appropriate partial derivatives (one in each dimension)
26176 hawk = (erhead_tail(k,1) + &
26177 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
26178 condor = (erhead_tail(k,2) + &
26179 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
26181 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26182 gradpepcatx(k,i) = gradpepcatx(k,i) &
26187 - dPOLdR2 * (erhead_tail(k,2)&
26188 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
26191 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
26192 ! gradpepcatx(k,j) = gradpepcatx(k,j)+ dGCLdR * pom&
26193 ! + dGGBdR * pom+ dGCVdR * pom&
26194 ! + dPOLdR1 * (erhead_tail(k,1)&
26195 ! -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j)))&
26196 ! + dPOLdR2 * condor + dGLJdR * pom
26198 gradpepcat(k,i) = gradpepcat(k,i) &
26199 - dGCLdR * erhead(k)&
26200 - dGGBdR * erhead(k)&
26201 - dGCVdR * erhead(k)&
26202 - dPOLdR1 * erhead_tail(k,1)&
26203 - dPOLdR2 * erhead_tail(k,2)&
26204 - dGLJdR * erhead(k)
26206 gradpepcat(k,j) = gradpepcat(k,j) &
26207 + dGCLdR * erhead(k) &
26208 + dGGBdR * erhead(k) &
26209 + dGCVdR * erhead(k) &
26210 + dPOLdR1 * erhead_tail(k,1) &
26211 + dPOLdR2 * erhead_tail(k,2)&
26212 + dGLJdR * erhead(k)
26216 END SUBROUTINE eqq_cat
26217 !c!-------------------------------------------------------------------
26218 SUBROUTINE energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
26222 double precision eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad
26223 double precision ener(4)
26224 double precision dcosom1(3),dcosom2(3)
26225 !c! used in Epol derivatives
26226 double precision facd3, facd4
26227 double precision federmaus, adler
26228 integer istate,ii,jj
26229 real (kind=8) :: Fgb
26230 ! print *,"CALLING EQUAD"
26231 !c! Epol and Gpol analytical parameters
26232 alphapol1 = alphapol(itypi,itypj)
26233 alphapol2 = alphapol(itypj,itypi)
26234 !c! Fisocav and Gisocav analytical parameters
26235 al1 = alphiso(1,itypi,itypj)
26236 al2 = alphiso(2,itypi,itypj)
26237 al3 = alphiso(3,itypi,itypj)
26238 al4 = alphiso(4,itypi,itypj)
26239 csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0&
26240 + sigiso2(itypi,itypj)**2.0d0))
26242 w1 = wqdip(1,itypi,itypj)
26243 w2 = wqdip(2,itypi,itypj)
26244 pis = sig0head(itypi,itypj)
26245 eps_head = epshead(itypi,itypj)
26246 !c! First things first:
26247 !c! We need to do sc_grad's job with GB and Fcav
26248 eom1 = eps2der * eps2rt_om1 &
26249 - 2.0D0 * alf1 * eps3der&
26250 + sigder * sigsq_om1&
26252 eom2 = eps2der * eps2rt_om2 &
26253 + 2.0D0 * alf2 * eps3der&
26254 + sigder * sigsq_om2&
26256 eom12 = evdwij * eps1_om12 &
26257 + eps2der * eps2rt_om12 &
26258 - 2.0D0 * alf12 * eps3der&
26259 + sigder *sigsq_om12&
26261 !c! now some magical transformations to project gradient into
26262 !c! three cartesian vectors
26264 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
26265 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
26266 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
26267 !c! this acts on hydrophobic center of interaction
26268 gvdwx(k,i)= gvdwx(k,i) - gg(k) &
26269 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
26270 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
26271 gvdwx(k,j)= gvdwx(k,j) + gg(k) &
26272 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
26273 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
26274 !c! this acts on Calpha
26275 gvdwc(k,i)=gvdwc(k,i)-gg(k)
26276 gvdwc(k,j)=gvdwc(k,j)+gg(k)
26278 !c! sc_grad is done, now we will compute
26283 DO istate = 1, nstate(itypi,itypj)
26284 !c*************************************************************
26285 IF (istate.ne.1) THEN
26286 IF (istate.lt.3) THEN
26292 d1 = dhead(1,ii,itypi,itypj)
26293 d2 = dhead(2,jj,itypi,itypj)
26295 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
26296 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
26297 Rhead_distance(k) = chead(k,2) - chead(k,1)
26299 !c! pitagoras (root of sum of squares)
26301 (Rhead_distance(1)*Rhead_distance(1)) &
26302 + (Rhead_distance(2)*Rhead_distance(2)) &
26303 + (Rhead_distance(3)*Rhead_distance(3)))
26305 Rhead_sq = Rhead * Rhead
26307 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26308 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26312 !c! Calculate head-to-tail distances
26313 R1=R1+(ctail(k,2)-chead(k,1))**2
26314 R2=R2+(chead(k,2)-ctail(k,1))**2
26319 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
26321 !c! write (*,*) "Ecl = ", Ecl
26322 !c! derivative of Ecl is Gcl...
26323 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
26328 !c!-------------------------------------------------------------------
26329 !c! Generalised Born Solvent Polarization
26330 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
26331 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
26332 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
26334 !c! write (*,*) "a1*a2 = ", a12sq
26335 !c! write (*,*) "Rhead = ", Rhead
26336 !c! write (*,*) "Rhead_sq = ", Rhead_sq
26337 !c! write (*,*) "ee = ", ee
26338 !c! write (*,*) "Fgb = ", Fgb
26339 !c! write (*,*) "fac = ", eps_inout_fac
26340 !c! write (*,*) "Qij = ", Qij
26341 !c! write (*,*) "Egb = ", Egb
26342 !c! Derivative of Egb is Ggb...
26343 !c! dFGBdR is used by Quad's later...
26344 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
26345 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
26347 dGGBdR = dGGBdFGB * dFGBdR
26349 !c!-------------------------------------------------------------------
26350 !c! Fisocav - isotropic cavity creation term
26352 top = al1 * (dsqrt(pom) + al2 * pom - al3)
26353 bot = (1.0d0 + al4 * pom**12.0d0)
26355 FisoCav = top / bot
26356 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
26357 dbot = 12.0d0 * al4 * pom ** 11.0d0
26358 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
26360 !c!-------------------------------------------------------------------
26361 !c! Polarization energy
26363 MomoFac1 = (1.0d0 - chi1 * sqom2)
26364 MomoFac2 = (1.0d0 - chi2 * sqom1)
26365 RR1 = ( R1 * R1 ) / MomoFac1
26366 RR2 = ( R2 * R2 ) / MomoFac2
26367 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26368 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
26369 fgb1 = sqrt( RR1 + a12sq * ee1 )
26370 fgb2 = sqrt( RR2 + a12sq * ee2 )
26371 epol = 332.0d0 * eps_inout_fac * (&
26372 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
26374 !c! derivative of Epol is Gpol...
26375 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
26377 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
26379 dFGBdR1 = ( (R1 / MomoFac1) &
26380 * ( 2.0d0 - (0.5d0 * ee1) ) )&
26382 dFGBdR2 = ( (R2 / MomoFac2) &
26383 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
26385 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
26386 * ( 2.0d0 - 0.5d0 * ee1) ) &
26388 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
26389 * ( 2.0d0 - 0.5d0 * ee2) ) &
26391 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26392 !c! dPOLdR1 = 0.0d0
26393 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26394 !c! dPOLdR2 = 0.0d0
26395 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26396 !c! dPOLdOM1 = 0.0d0
26397 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26398 pom = (pis / Rhead)**6.0d0
26399 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26401 !c! derivative of Elj is Glj
26402 dGLJdR = 4.0d0 * eps_head &
26403 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
26404 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26406 !c!-------------------------------------------------------------------
26408 IF (Wqd.ne.0.0d0) THEN
26409 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
26410 - 37.5d0 * ( sqom1 + sqom2 ) &
26411 + 157.5d0 * ( sqom1 * sqom2 ) &
26412 - 45.0d0 * om1*om2*om12
26413 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
26414 Equad = fac * Beta1
26416 !c! derivative of Equad...
26417 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
26418 !c! dQUADdR = 0.0d0
26419 dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
26420 !c! dQUADdOM1 = 0.0d0
26421 dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
26422 !c! dQUADdOM2 = 0.0d0
26423 dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
26428 !c!-------------------------------------------------------------------
26429 !c! Return the results
26431 eom1 = dPOLdOM1 + dQUADdOM1
26432 eom2 = dPOLdOM2 + dQUADdOM2
26434 !c! now some magical transformations to project gradient into
26435 !c! three cartesian vectors
26437 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
26438 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
26439 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
26443 erhead(k) = Rhead_distance(k)/Rhead
26444 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26445 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26447 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26448 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
26449 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26450 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
26451 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
26452 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26453 facd1 = d1 * vbld_inv(i+nres)
26454 facd2 = d2 * vbld_inv(j+nres)
26455 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26456 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26458 hawk = erhead_tail(k,1) + &
26459 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
26460 condor = erhead_tail(k,2) + &
26461 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
26463 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26464 !c! this acts on hydrophobic center of interaction
26465 gheadtail(k,1,1) = gheadtail(k,1,1) &
26470 - dPOLdR2 * (erhead_tail(k,2) &
26471 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
26475 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
26476 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
26478 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26479 !c! this acts on hydrophobic center of interaction
26480 gheadtail(k,2,1) = gheadtail(k,2,1) &
26484 + dPOLdR1 * (erhead_tail(k,1) &
26485 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
26486 + dPOLdR2 * condor &
26490 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
26491 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
26493 !c! this acts on Calpha
26494 gheadtail(k,3,1) = gheadtail(k,3,1) &
26495 - dGCLdR * erhead(k)&
26496 - dGGBdR * erhead(k)&
26497 - dGCVdR * erhead(k)&
26498 - dPOLdR1 * erhead_tail(k,1)&
26499 - dPOLdR2 * erhead_tail(k,2)&
26500 - dGLJdR * erhead(k) &
26501 - dQUADdR * erhead(k)&
26503 !c! this acts on Calpha
26504 gheadtail(k,4,1) = gheadtail(k,4,1) &
26505 + dGCLdR * erhead(k) &
26506 + dGGBdR * erhead(k) &
26507 + dGCVdR * erhead(k) &
26508 + dPOLdR1 * erhead_tail(k,1) &
26509 + dPOLdR2 * erhead_tail(k,2) &
26510 + dGLJdR * erhead(k) &
26511 + dQUADdR * erhead(k)&
26514 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
26515 eheadtail = eheadtail &
26516 + wstate(istate, itypi, itypj) &
26517 * dexp(-betaT * ener(istate))
26518 !c! foreach cartesian dimension
26520 !c! foreach of two gvdwx and gvdwc
26522 gheadtail(k,l,2) = gheadtail(k,l,2) &
26523 + wstate( istate, itypi, itypj ) &
26524 * dexp(-betaT * ener(istate)) &
26526 gheadtail(k,l,1) = 0.0d0
26530 !c! Here ended the gigantic DO istate = 1, 4, which starts
26531 !c! at the beggining of the subroutine
26535 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
26537 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
26538 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
26539 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
26540 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
26542 gheadtail(k,l,1) = 0.0d0
26543 gheadtail(k,l,2) = 0.0d0
26546 eheadtail = (-dlog(eheadtail)) / betaT
26553 END SUBROUTINE energy_quad
26554 !!-----------------------------------------------------------
26555 SUBROUTINE eqn(Epol)
26559 double precision facd4, federmaus,epol
26560 alphapol1 = alphapol(itypi,itypj)
26561 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26564 !c! Calculate head-to-tail distances
26565 R1=R1+(ctail(k,2)-chead(k,1))**2
26570 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26571 !c! & +dhead(1,1,itypi,itypj))**2))
26572 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26573 !c! & +dhead(2,1,itypi,itypj))**2))
26574 !c--------------------------------------------------------------------
26575 !c Polarization energy
26577 MomoFac1 = (1.0d0 - chi1 * sqom2)
26578 RR1 = R1 * R1 / MomoFac1
26579 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26580 fgb1 = sqrt( RR1 + a12sq * ee1)
26581 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
26582 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
26584 dFGBdR1 = ( (R1 / MomoFac1) &
26585 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
26587 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
26588 * (2.0d0 - 0.5d0 * ee1) ) &
26590 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26591 !c! dPOLdR1 = 0.0d0
26593 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26595 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26597 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26598 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
26599 facd1 = d1 * vbld_inv(i+nres)
26600 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26603 hawk = (erhead_tail(k,1) + &
26604 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
26606 gvdwx(k,i) = gvdwx(k,i) &
26608 gvdwx(k,j) = gvdwx(k,j) &
26609 + dPOLdR1 * (erhead_tail(k,1) &
26610 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
26612 gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
26613 gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
26618 SUBROUTINE enq(Epol)
26621 double precision facd3, adler,epol
26622 alphapol2 = alphapol(itypj,itypi)
26623 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26626 !c! Calculate head-to-tail distances
26627 R2=R2+(chead(k,2)-ctail(k,1))**2
26632 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26633 !c! & +dhead(1,1,itypi,itypj))**2))
26634 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26635 !c! & +dhead(2,1,itypi,itypj))**2))
26636 !c------------------------------------------------------------------------
26637 !c Polarization energy
26638 MomoFac2 = (1.0d0 - chi2 * sqom1)
26639 RR2 = R2 * R2 / MomoFac2
26640 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
26641 fgb2 = sqrt(RR2 + a12sq * ee2)
26642 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
26643 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
26645 dFGBdR2 = ( (R2 / MomoFac2) &
26646 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
26648 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
26649 * (2.0d0 - 0.5d0 * ee2) ) &
26651 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26652 !c! dPOLdR2 = 0.0d0
26653 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26654 !c! dPOLdOM1 = 0.0d0
26656 !c!-------------------------------------------------------------------
26657 !c! Return the results
26658 !c! (See comments in Eqq)
26660 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26662 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
26663 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26664 facd2 = d2 * vbld_inv(j+nres)
26665 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26667 condor = (erhead_tail(k,2) &
26668 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
26670 gvdwx(k,i) = gvdwx(k,i) &
26671 - dPOLdR2 * (erhead_tail(k,2) &
26672 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
26673 gvdwx(k,j) = gvdwx(k,j) &
26676 gvdwc(k,i) = gvdwc(k,i) &
26677 - dPOLdR2 * erhead_tail(k,2)
26678 gvdwc(k,j) = gvdwc(k,j) &
26679 + dPOLdR2 * erhead_tail(k,2)
26685 SUBROUTINE enq_cat(Epol)
26688 double precision facd3, adler,epol
26689 alphapol2 = alphapolcat(itypi,itypj)
26690 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26693 !c! Calculate head-to-tail distances
26694 R2=R2+(chead(k,2)-ctail(k,1))**2
26699 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26700 !c! & +dhead(1,1,itypi,itypj))**2))
26701 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26702 !c! & +dhead(2,1,itypi,itypj))**2))
26703 !c------------------------------------------------------------------------
26704 !c Polarization energy
26705 MomoFac2 = (1.0d0 - chi2 * sqom1)
26706 RR2 = R2 * R2 / MomoFac2
26707 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
26708 fgb2 = sqrt(RR2 + a12sq * ee2)
26709 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
26710 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
26712 dFGBdR2 = ( (R2 / MomoFac2) &
26713 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
26715 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
26716 * (2.0d0 - 0.5d0 * ee2) ) &
26718 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26719 !c! dPOLdR2 = 0.0d0
26720 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26721 !c! dPOLdOM1 = 0.0d0
26724 !c!-------------------------------------------------------------------
26725 !c! Return the results
26726 !c! (See comments in Eqq)
26728 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26730 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
26731 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26732 facd2 = d2 * vbld_inv(j+nres)
26733 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
26735 condor = (erhead_tail(k,2) &
26736 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
26738 gradpepcatx(k,i) = gradpepcatx(k,i) &
26739 - dPOLdR2 * (erhead_tail(k,2) &
26740 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
26741 ! gradpepcatx(k,j) = gradpepcatx(k,j) &
26742 ! + dPOLdR2 * condor
26744 gradpepcat(k,i) = gradpepcat(k,i) &
26745 - dPOLdR2 * erhead_tail(k,2)
26746 gradpepcat(k,j) = gradpepcat(k,j) &
26747 + dPOLdR2 * erhead_tail(k,2)
26751 END SUBROUTINE enq_cat
26753 SUBROUTINE eqd(Ecl,Elj,Epol)
26756 double precision facd4, federmaus,ecl,elj,epol
26757 alphapol1 = alphapol(itypi,itypj)
26758 w1 = wqdip(1,itypi,itypj)
26759 w2 = wqdip(2,itypi,itypj)
26760 pis = sig0head(itypi,itypj)
26761 eps_head = epshead(itypi,itypj)
26762 !c!-------------------------------------------------------------------
26763 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26766 !c! Calculate head-to-tail distances
26767 R1=R1+(ctail(k,2)-chead(k,1))**2
26772 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26773 !c! & +dhead(1,1,itypi,itypj))**2))
26774 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26775 !c! & +dhead(2,1,itypi,itypj))**2))
26777 !c!-------------------------------------------------------------------
26779 sparrow = w1 * Qi * om1
26780 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
26781 Ecl = sparrow / Rhead**2.0d0 &
26782 - hawk / Rhead**4.0d0
26783 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
26784 + 4.0d0 * hawk / Rhead**5.0d0
26786 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
26788 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
26789 !c--------------------------------------------------------------------
26790 !c Polarization energy
26792 MomoFac1 = (1.0d0 - chi1 * sqom2)
26793 RR1 = R1 * R1 / MomoFac1
26794 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26795 fgb1 = sqrt( RR1 + a12sq * ee1)
26796 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
26798 !c!------------------------------------------------------------------
26799 !c! derivative of Epol is Gpol...
26800 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
26802 dFGBdR1 = ( (R1 / MomoFac1) &
26803 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
26805 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
26806 * (2.0d0 - 0.5d0 * ee1) ) &
26808 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26809 !c! dPOLdR1 = 0.0d0
26811 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26812 !c! dPOLdOM2 = 0.0d0
26813 !c!-------------------------------------------------------------------
26815 pom = (pis / Rhead)**6.0d0
26816 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26817 !c! derivative of Elj is Glj
26818 dGLJdR = 4.0d0 * eps_head &
26819 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
26820 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26822 erhead(k) = Rhead_distance(k)/Rhead
26823 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26826 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26827 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
26828 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26829 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
26830 facd1 = d1 * vbld_inv(i+nres)
26831 facd2 = d2 * vbld_inv(j+nres)
26832 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26835 hawk = (erhead_tail(k,1) + &
26836 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
26838 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26839 gvdwx(k,i) = gvdwx(k,i) &
26844 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26845 gvdwx(k,j) = gvdwx(k,j) &
26847 + dPOLdR1 * (erhead_tail(k,1) &
26848 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
26852 gvdwc(k,i) = gvdwc(k,i) &
26853 - dGCLdR * erhead(k) &
26854 - dPOLdR1 * erhead_tail(k,1) &
26855 - dGLJdR * erhead(k)
26857 gvdwc(k,j) = gvdwc(k,j) &
26858 + dGCLdR * erhead(k) &
26859 + dPOLdR1 * erhead_tail(k,1) &
26860 + dGLJdR * erhead(k)
26865 SUBROUTINE edq(Ecl,Elj,Epol)
26870 double precision facd3, adler,ecl,elj,epol
26871 alphapol2 = alphapol(itypj,itypi)
26872 w1 = wqdip(1,itypi,itypj)
26873 w2 = wqdip(2,itypi,itypj)
26874 pis = sig0head(itypi,itypj)
26875 eps_head = epshead(itypi,itypj)
26876 !c!-------------------------------------------------------------------
26877 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26880 !c! Calculate head-to-tail distances
26881 R2=R2+(chead(k,2)-ctail(k,1))**2
26886 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26887 !c! & +dhead(1,1,itypi,itypj))**2))
26888 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26889 !c! & +dhead(2,1,itypi,itypj))**2))
26892 !c!-------------------------------------------------------------------
26894 sparrow = w1 * Qj * om1
26895 hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
26896 ECL = sparrow / Rhead**2.0d0 &
26897 - hawk / Rhead**4.0d0
26898 !c!-------------------------------------------------------------------
26899 !c! derivative of ecl is Gcl
26901 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
26902 + 4.0d0 * hawk / Rhead**5.0d0
26904 dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
26906 dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
26907 !c--------------------------------------------------------------------
26908 !c Polarization energy
26910 MomoFac2 = (1.0d0 - chi2 * sqom1)
26911 RR2 = R2 * R2 / MomoFac2
26912 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
26913 fgb2 = sqrt(RR2 + a12sq * ee2)
26914 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
26915 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
26917 dFGBdR2 = ( (R2 / MomoFac2) &
26918 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
26920 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
26921 * (2.0d0 - 0.5d0 * ee2) ) &
26923 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26924 !c! dPOLdR2 = 0.0d0
26925 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26926 !c! dPOLdOM1 = 0.0d0
26928 !c!-------------------------------------------------------------------
26930 pom = (pis / Rhead)**6.0d0
26931 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26932 !c! derivative of Elj is Glj
26933 dGLJdR = 4.0d0 * eps_head &
26934 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
26935 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26936 !c!-------------------------------------------------------------------
26937 !c! Return the results
26938 !c! (see comments in Eqq)
26940 erhead(k) = Rhead_distance(k)/Rhead
26941 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26943 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26944 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
26945 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
26946 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26947 facd1 = d1 * vbld_inv(i+nres)
26948 facd2 = d2 * vbld_inv(j+nres)
26949 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26951 condor = (erhead_tail(k,2) &
26952 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
26954 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26955 gvdwx(k,i) = gvdwx(k,i) &
26957 - dPOLdR2 * (erhead_tail(k,2) &
26958 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
26961 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26962 gvdwx(k,j) = gvdwx(k,j) &
26964 + dPOLdR2 * condor &
26968 gvdwc(k,i) = gvdwc(k,i) &
26969 - dGCLdR * erhead(k) &
26970 - dPOLdR2 * erhead_tail(k,2) &
26971 - dGLJdR * erhead(k)
26973 gvdwc(k,j) = gvdwc(k,j) &
26974 + dGCLdR * erhead(k) &
26975 + dPOLdR2 * erhead_tail(k,2) &
26976 + dGLJdR * erhead(k)
26982 SUBROUTINE edq_cat(Ecl,Elj,Epol)
26986 double precision facd3, adler,ecl,elj,epol
26987 alphapol2 = alphapolcat(itypi,itypj)
26988 w1 = wqdipcat(1,itypi,itypj)
26989 w2 = wqdipcat(2,itypi,itypj)
26990 pis = sig0headcat(itypi,itypj)
26991 eps_head = epsheadcat(itypi,itypj)
26992 !c!-------------------------------------------------------------------
26993 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26996 !c! Calculate head-to-tail distances
26997 R2=R2+(chead(k,2)-ctail(k,1))**2
27002 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27003 !c! & +dhead(1,1,itypi,itypj))**2))
27004 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27005 !c! & +dhead(2,1,itypi,itypj))**2))
27008 !c!-------------------------------------------------------------------
27010 ! write(iout,*) "KURWA2",Rhead
27011 sparrow = w1 * Qj * om1
27012 hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
27013 ECL = sparrow / Rhead**2.0d0 &
27014 - hawk / Rhead**4.0d0
27015 !c!-------------------------------------------------------------------
27016 !c! derivative of ecl is Gcl
27018 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
27019 + 4.0d0 * hawk / Rhead**5.0d0
27021 dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
27023 dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
27024 !c--------------------------------------------------------------------
27025 !c--------------------------------------------------------------------
27026 !c Polarization energy
27028 MomoFac2 = (1.0d0 - chi2 * sqom1)
27029 RR2 = R2 * R2 / MomoFac2
27030 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
27031 fgb2 = sqrt(RR2 + a12sq * ee2)
27032 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
27033 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
27035 dFGBdR2 = ( (R2 / MomoFac2) &
27036 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
27038 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
27039 * (2.0d0 - 0.5d0 * ee2) ) &
27041 dPOLdR2 = dPOLdFGB2 * dFGBdR2
27042 !c! dPOLdR2 = 0.0d0
27043 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
27044 !c! dPOLdOM1 = 0.0d0
27046 !c!-------------------------------------------------------------------
27048 pom = (pis / Rhead)**6.0d0
27049 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
27050 !c! derivative of Elj is Glj
27051 dGLJdR = 4.0d0 * eps_head &
27052 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
27053 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
27054 !c!-------------------------------------------------------------------
27056 !c! Return the results
27057 !c! (see comments in Eqq)
27059 erhead(k) = Rhead_distance(k)/Rhead
27060 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
27062 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27063 erdxj = scalar( erhead(1), dC_norm(1,j) )
27064 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
27065 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
27066 facd1 = d1 * vbld_inv(i+nres)
27067 facd2 = d2 * vbld_inv(j)
27068 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
27070 condor = (erhead_tail(k,2) &
27071 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
27073 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27074 gradpepcatx(k,i) = gradpepcatx(k,i) &
27076 - dPOLdR2 * (erhead_tail(k,2) &
27077 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
27080 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
27081 ! gradpepcatx(k,j) = gradpepcatx(k,j) &
27083 ! + dPOLdR2 * condor &
27087 gradpepcat(k,i) = gradpepcat(k,i) &
27088 - dGCLdR * erhead(k) &
27089 - dPOLdR2 * erhead_tail(k,2) &
27090 - dGLJdR * erhead(k)
27092 gradpepcat(k,j) = gradpepcat(k,j) &
27093 + dGCLdR * erhead(k) &
27094 + dPOLdR2 * erhead_tail(k,2) &
27095 + dGLJdR * erhead(k)
27099 END SUBROUTINE edq_cat
27101 SUBROUTINE edq_cat_pep(Ecl,Elj,Epol)
27105 double precision facd3, adler,ecl,elj,epol
27106 alphapol2 = alphapolcat(itypi,itypj)
27107 w1 = wqdipcat(1,itypi,itypj)
27108 w2 = wqdipcat(2,itypi,itypj)
27109 pis = sig0headcat(itypi,itypj)
27110 eps_head = epsheadcat(itypi,itypj)
27111 !c!-------------------------------------------------------------------
27112 !c! R2 - distance between head of jth side chain and tail of ith sidechain
27115 !c! Calculate head-to-tail distances
27116 R2=R2+(chead(k,2)-ctail(k,1))**2
27121 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27122 !c! & +dhead(1,1,itypi,itypj))**2))
27123 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27124 !c! & +dhead(2,1,itypi,itypj))**2))
27127 !c!-------------------------------------------------------------------
27129 sparrow = w1 * Qj * om1
27130 hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
27131 ! print *,"CO2", itypi,itypj
27132 ! print *,"CO?!.", w1,w2,Qj,om1
27133 ECL = sparrow / Rhead**2.0d0 &
27134 - hawk / Rhead**4.0d0
27135 !c!-------------------------------------------------------------------
27136 !c! derivative of ecl is Gcl
27138 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
27139 + 4.0d0 * hawk / Rhead**5.0d0
27141 dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
27143 dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
27144 !c--------------------------------------------------------------------
27145 !c--------------------------------------------------------------------
27146 !c Polarization energy
27148 MomoFac2 = (1.0d0 - chi2 * sqom1)
27149 RR2 = R2 * R2 / MomoFac2
27150 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
27151 fgb2 = sqrt(RR2 + a12sq * ee2)
27152 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
27153 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
27155 dFGBdR2 = ( (R2 / MomoFac2) &
27156 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
27158 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
27159 * (2.0d0 - 0.5d0 * ee2) ) &
27161 dPOLdR2 = dPOLdFGB2 * dFGBdR2
27162 !c! dPOLdR2 = 0.0d0
27163 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
27164 !c! dPOLdOM1 = 0.0d0
27166 !c!-------------------------------------------------------------------
27168 pom = (pis / Rhead)**6.0d0
27169 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
27170 !c! derivative of Elj is Glj
27171 dGLJdR = 4.0d0 * eps_head &
27172 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
27173 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
27174 !c!-------------------------------------------------------------------
27176 !c! Return the results
27177 !c! (see comments in Eqq)
27179 erhead(k) = Rhead_distance(k)/Rhead
27180 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
27182 erdxi = scalar( erhead(1), dC_norm(1,i) )
27183 erdxj = scalar( erhead(1), dC_norm(1,j) )
27184 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
27185 adler = scalar( erhead_tail(1,2), dC_norm(1,i) )
27186 facd1 = d1 * vbld_inv(i+1)/2.0
27187 facd2 = d2 * vbld_inv(j)
27188 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+1)/2.0
27190 condor = (erhead_tail(k,2) &
27191 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
27193 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i))
27194 ! gradpepcatx(k,i) = gradpepcatx(k,i) &
27196 ! - dPOLdR2 * (erhead_tail(k,2) &
27197 ! -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
27200 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
27201 ! gradpepcatx(k,j) = gradpepcatx(k,j) &
27203 ! + dPOLdR2 * condor &
27207 gradpepcat(k,i) = gradpepcat(k,i) +0.5d0*( &
27208 - dGCLdR * erhead(k) &
27209 - dPOLdR2 * erhead_tail(k,2) &
27210 - dGLJdR * erhead(k))
27211 gradpepcat(k,i+1) = gradpepcat(k,i+1) +0.5d0*( &
27212 - dGCLdR * erhead(k) &
27213 - dPOLdR2 * erhead_tail(k,2) &
27214 - dGLJdR * erhead(k))
27217 gradpepcat(k,j) = gradpepcat(k,j) &
27218 + dGCLdR * erhead(k) &
27219 + dPOLdR2 * erhead_tail(k,2) &
27220 + dGLJdR * erhead(k)
27224 END SUBROUTINE edq_cat_pep
27226 SUBROUTINE edd(ECL)
27231 double precision ecl
27232 !c! csig = sigiso(itypi,itypj)
27233 w1 = wqdip(1,itypi,itypj)
27234 w2 = wqdip(2,itypi,itypj)
27235 !c!-------------------------------------------------------------------
27237 fac = (om12 - 3.0d0 * om1 * om2)
27238 c1 = (w1 / (Rhead**3.0d0)) * fac
27239 c2 = (w2 / Rhead ** 6.0d0) &
27240 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
27242 !c! write (*,*) "w1 = ", w1
27243 !c! write (*,*) "w2 = ", w2
27244 !c! write (*,*) "om1 = ", om1
27245 !c! write (*,*) "om2 = ", om2
27246 !c! write (*,*) "om12 = ", om12
27247 !c! write (*,*) "fac = ", fac
27248 !c! write (*,*) "c1 = ", c1
27249 !c! write (*,*) "c2 = ", c2
27250 !c! write (*,*) "Ecl = ", Ecl
27251 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
27252 !c! write (*,*) "c2_2 = ",
27253 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
27254 !c!-------------------------------------------------------------------
27255 !c! dervative of ECL is GCL...
27257 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
27258 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
27259 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
27262 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
27263 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
27264 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
27267 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
27268 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
27269 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
27272 c1 = w1 / (Rhead ** 3.0d0)
27273 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
27274 dGCLdOM12 = c1 - c2
27275 !c!-------------------------------------------------------------------
27276 !c! Return the results
27277 !c! (see comments in Eqq)
27279 erhead(k) = Rhead_distance(k)/Rhead
27281 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27282 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
27283 facd1 = d1 * vbld_inv(i+nres)
27284 facd2 = d2 * vbld_inv(j+nres)
27287 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27288 gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom
27289 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
27290 gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom
27292 gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k)
27293 gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k)
27297 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
27302 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
27306 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
27307 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
27309 !c! BetaT = 1.0d0 / (t_bath * Rb)i
27311 BetaT = 1.0d0 / (298.0d0 * Rb)
27312 !c! Gay-berne var's
27313 sig0ij = sigma( itypi,itypj )
27314 chi1 = chi( itypi, itypj )
27315 chi2 = chi( itypj, itypi )
27316 chi12 = chi1 * chi2
27317 chip1 = chipp( itypi, itypj )
27318 chip2 = chipp( itypj, itypi )
27319 chip12 = chip1 * chip2
27326 !c! not used by momo potential, but needed by sc_angular which is shared
27327 !c! by all energy_potential subroutines
27331 !c! location, location, location
27332 ! xj = c( 1, nres+j ) - xi
27333 ! yj = c( 2, nres+j ) - yi
27334 ! zj = c( 3, nres+j ) - zi
27335 dxj = dc_norm( 1, nres+j )
27336 dyj = dc_norm( 2, nres+j )
27337 dzj = dc_norm( 3, nres+j )
27338 !c! distance from center of chain(?) to polar/charged head
27339 !c! write (*,*) "istate = ", 1
27340 !c! write (*,*) "ii = ", 1
27341 !c! write (*,*) "jj = ", 1
27342 d1 = dhead(1, 1, itypi, itypj)
27343 d2 = dhead(2, 1, itypi, itypj)
27345 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
27346 !c! a12sq = a12sq * a12sq
27347 !c! charge of amino acid itypi is...
27348 Qi = icharge(itypi)
27349 Qj = icharge(itypj)
27352 chis1 = chis(itypi,itypj)
27353 chis2 = chis(itypj,itypi)
27354 chis12 = chis1 * chis2
27355 sig1 = sigmap1(itypi,itypj)
27356 sig2 = sigmap2(itypi,itypj)
27357 !c! write (*,*) "sig1 = ", sig1
27358 !c! write (*,*) "sig2 = ", sig2
27359 !c! alpha factors from Fcav/Gcav
27360 b1cav = alphasur(1,itypi,itypj)
27362 b2cav = alphasur(2,itypi,itypj)
27363 b3cav = alphasur(3,itypi,itypj)
27364 b4cav = alphasur(4,itypi,itypj)
27365 wqd = wquad(itypi, itypj)
27367 eps_in = epsintab(itypi,itypj)
27368 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
27369 !c! write (*,*) "eps_inout_fac = ", eps_inout_fac
27370 !c!-------------------------------------------------------------------
27371 !c! tail location and distance calculations
27374 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
27375 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
27377 !c! tail distances will be themselves usefull elswhere
27378 !c1 (in Gcav, for example)
27379 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
27380 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
27381 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
27383 (Rtail_distance(1)*Rtail_distance(1)) &
27384 + (Rtail_distance(2)*Rtail_distance(2)) &
27385 + (Rtail_distance(3)*Rtail_distance(3)))
27386 !c!-------------------------------------------------------------------
27387 !c! Calculate location and distance between polar heads
27388 !c! distance between heads
27389 !c! for each one of our three dimensional space...
27390 d1 = dhead(1, 1, itypi, itypj)
27391 d2 = dhead(2, 1, itypi, itypj)
27394 !c! location of polar head is computed by taking hydrophobic centre
27395 !c! and moving by a d1 * dc_norm vector
27396 !c! see unres publications for very informative images
27397 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
27398 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
27400 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
27401 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
27402 Rhead_distance(k) = chead(k,2) - chead(k,1)
27404 !c! pitagoras (root of sum of squares)
27406 (Rhead_distance(1)*Rhead_distance(1)) &
27407 + (Rhead_distance(2)*Rhead_distance(2)) &
27408 + (Rhead_distance(3)*Rhead_distance(3)))
27409 !c!-------------------------------------------------------------------
27410 !c! zero everything that should be zero'ed
27423 END SUBROUTINE elgrad_init
27426 SUBROUTINE elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
27429 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
27433 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
27434 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
27436 !c! BetaT = 1.0d0 / (t_bath * Rb)i
27438 BetaT = 1.0d0 / (298.0d0 * Rb)
27439 !c! Gay-berne var's
27440 sig0ij = sigmacat( itypi,itypj )
27441 chi1 = chi1cat( itypi, itypj )
27444 chip1 = chipp1cat( itypi, itypj )
27447 !c! not used by momo potential, but needed by sc_angular which is shared
27448 !c! by all energy_potential subroutines
27452 dxj = 0.0d0 !dc_norm( 1, nres+j )
27453 dyj = 0.0d0 !dc_norm( 2, nres+j )
27454 dzj = 0.0d0 !dc_norm( 3, nres+j )
27455 !c! distance from center of chain(?) to polar/charged head
27456 d1 = dheadcat(1, 1, itypi, itypj)
27457 d2 = dheadcat(2, 1, itypi, itypj)
27459 a12sq = rborn1cat(itypi,itypj) * rborn2cat(itypi,itypj)
27460 !c! a12sq = a12sq * a12sq
27461 !c! charge of amino acid itypi is...
27462 Qi = icharge(itypi)
27463 Qj = ichargecat(itypj)
27466 chis1 = chis1cat(itypi,itypj)
27469 sig1 = sigmap1cat(itypi,itypj)
27470 sig2 = sigmap2cat(itypi,itypj)
27471 !c! alpha factors from Fcav/Gcav
27472 b1cav = alphasurcat(1,itypi,itypj)
27473 b2cav = alphasurcat(2,itypi,itypj)
27474 b3cav = alphasurcat(3,itypi,itypj)
27475 b4cav = alphasurcat(4,itypi,itypj)
27476 wqd = wquadcat(itypi, itypj)
27478 eps_in = epsintabcat(itypi,itypj)
27479 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
27480 !c!-------------------------------------------------------------------
27481 !c! tail location and distance calculations
27484 ctail(k,1)=c(k,i+nres)-dtailcat(1,itypi,itypj)*dc_norm(k,nres+i)
27485 ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
27487 !c! tail distances will be themselves usefull elswhere
27488 !c1 (in Gcav, for example)
27489 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
27490 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
27491 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
27493 (Rtail_distance(1)*Rtail_distance(1)) &
27494 + (Rtail_distance(2)*Rtail_distance(2)) &
27495 + (Rtail_distance(3)*Rtail_distance(3)))
27496 !c!-------------------------------------------------------------------
27497 !c! Calculate location and distance between polar heads
27498 !c! distance between heads
27499 !c! for each one of our three dimensional space...
27500 d1 = dheadcat(1, 1, itypi, itypj)
27501 d2 = dheadcat(2, 1, itypi, itypj)
27504 !c! location of polar head is computed by taking hydrophobic centre
27505 !c! and moving by a d1 * dc_norm vector
27506 !c! see unres publications for very informative images
27507 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
27508 chead(k,2) = c(k, j)
27510 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
27511 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
27512 Rhead_distance(k) = chead(k,2) - chead(k,1)
27514 !c! pitagoras (root of sum of squares)
27516 (Rhead_distance(1)*Rhead_distance(1)) &
27517 + (Rhead_distance(2)*Rhead_distance(2)) &
27518 + (Rhead_distance(3)*Rhead_distance(3)))
27519 !c!-------------------------------------------------------------------
27520 !c! zero everything that should be zero'ed
27533 END SUBROUTINE elgrad_init_cat
27535 SUBROUTINE elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
27538 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
27542 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
27543 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
27545 !c! BetaT = 1.0d0 / (t_bath * Rb)i
27547 BetaT = 1.0d0 / (298.0d0 * Rb)
27548 !c! Gay-berne var's
27549 sig0ij = sigmacat( itypi,itypj )
27550 chi1 = chi1cat( itypi, itypj )
27553 chip1 = chipp1cat( itypi, itypj )
27556 !c! not used by momo potential, but needed by sc_angular which is shared
27557 !c! by all energy_potential subroutines
27561 dxj = 0.0d0 !dc_norm( 1, nres+j )
27562 dyj = 0.0d0 !dc_norm( 2, nres+j )
27563 dzj = 0.0d0 !dc_norm( 3, nres+j )
27564 !c! distance from center of chain(?) to polar/charged head
27565 d1 = dheadcat(1, 1, itypi, itypj)
27566 d2 = dheadcat(2, 1, itypi, itypj)
27568 a12sq = rborn1cat(itypi,itypj) * rborn2cat(itypi,itypj)
27569 !c! a12sq = a12sq * a12sq
27570 !c! charge of amino acid itypi is...
27572 Qj = ichargecat(itypj)
27575 chis1 = chis1cat(itypi,itypj)
27578 sig1 = sigmap1cat(itypi,itypj)
27579 sig2 = sigmap2cat(itypi,itypj)
27580 !c! alpha factors from Fcav/Gcav
27581 b1cav = alphasurcat(1,itypi,itypj)
27582 b2cav = alphasurcat(2,itypi,itypj)
27583 b3cav = alphasurcat(3,itypi,itypj)
27584 b4cav = alphasurcat(4,itypi,itypj)
27585 wqd = wquadcat(itypi, itypj)
27587 eps_in = epsintabcat(itypi,itypj)
27588 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
27589 !c!-------------------------------------------------------------------
27590 !c! tail location and distance calculations
27593 ctail(k,1)=(c(k,i)+c(k,i+1))/2.0-dtailcat(1,itypi,itypj)*dc_norm(k,i)
27594 ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
27596 !c! tail distances will be themselves usefull elswhere
27597 !c1 (in Gcav, for example)
27598 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
27599 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
27600 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
27602 (Rtail_distance(1)*Rtail_distance(1)) &
27603 + (Rtail_distance(2)*Rtail_distance(2)) &
27604 + (Rtail_distance(3)*Rtail_distance(3)))
27605 !c!-------------------------------------------------------------------
27606 !c! Calculate location and distance between polar heads
27607 !c! distance between heads
27608 !c! for each one of our three dimensional space...
27609 d1 = dheadcat(1, 1, itypi, itypj)
27610 d2 = dheadcat(2, 1, itypi, itypj)
27613 !c! location of polar head is computed by taking hydrophobic centre
27614 !c! and moving by a d1 * dc_norm vector
27615 !c! see unres publications for very informative images
27616 chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
27617 chead(k,2) = c(k, j)
27619 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
27620 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
27621 Rhead_distance(k) = chead(k,2) - chead(k,1)
27623 !c! pitagoras (root of sum of squares)
27625 (Rhead_distance(1)*Rhead_distance(1)) &
27626 + (Rhead_distance(2)*Rhead_distance(2)) &
27627 + (Rhead_distance(3)*Rhead_distance(3)))
27628 !c!-------------------------------------------------------------------
27629 !c! zero everything that should be zero'ed
27642 END SUBROUTINE elgrad_init_cat_pep
27644 double precision function tschebyshev(m,n,x,y)
27647 double precision x(n),y,yy(0:maxvar),aux
27648 !c Tschebyshev polynomial. Note that the first term is omitted
27649 !c m=0: the constant term is included
27650 !c m=1: the constant term is not included
27654 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
27662 end function tschebyshev
27663 !C--------------------------------------------------------------------------
27664 double precision function gradtschebyshev(m,n,x,y)
27667 double precision x(n+1),y,yy(0:maxvar),aux
27668 !c Tschebyshev polynomial. Note that the first term is omitted
27669 !c m=0: the constant term is included
27670 !c m=1: the constant term is not included
27674 yy(i)=2*y*yy(i-1)-yy(i-2)
27678 aux=aux+x(i+1)*yy(i)*(i+1)
27679 !C print *, x(i+1),yy(i),i
27681 gradtschebyshev=aux
27683 end function gradtschebyshev
27685 subroutine make_SCSC_inter_list
27687 real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
27688 real*8 :: dist_init, dist_temp,r_buff_list
27689 integer:: contlisti(250*nres),contlistj(250*nres)
27690 ! integer :: newcontlisti(200*nres),newcontlistj(200*nres)
27691 integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_sc,g_ilist_sc
27692 integer displ(0:nprocs),i_ilist_sc(0:nprocs),ierr
27693 ! print *,"START make_SC"
27696 do i=iatsc_s,iatsc_e
27697 itypi=iabs(itype(i,1))
27698 if (itypi.eq.ntyp1) cycle
27702 call to_box(xi,yi,zi)
27703 do iint=1,nint_gr(i)
27704 ! print *,"is it wrong", iint,i
27705 do j=istart(i,iint),iend(i,iint)
27706 itypj=iabs(itype(j,1))
27707 if (energy_dec) write(iout,*) "LISTA ZAKRES",istart(i,iint),iend(i,iint),iatsc_s,iatsc_e
27708 if (itypj.eq.ntyp1) cycle
27712 call to_box(xj,yj,zj)
27713 ! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
27714 ! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
27715 xj=boxshift(xj-xi,boxxsize)
27716 yj=boxshift(yj-yi,boxysize)
27717 zj=boxshift(zj-zi,boxzsize)
27718 dist_init=xj**2+yj**2+zj**2
27719 ! dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
27720 ! r_buff_list is a read value for a buffer
27721 if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
27722 ! Here the list is created
27723 ilist_sc=ilist_sc+1
27724 ! this can be substituted by cantor and anti-cantor
27725 contlisti(ilist_sc)=i
27726 contlistj(ilist_sc)=j
27732 ! call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
27733 ! MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
27734 ! call MPI_Gather(newnss,1,MPI_INTEGER,&
27735 ! i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
27737 write (iout,*) "before MPIREDUCE",ilist_sc
27739 write (iout,*) i,contlisti(i),contlistj(i)
27742 if (nfgtasks.gt.1)then
27744 call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
27745 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
27746 ! write(iout,*) "before bcast",g_ilist_sc
27747 call MPI_Gather(ilist_sc,1,MPI_INTEGER,&
27748 i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR)
27750 do i=1,nfgtasks-1,1
27751 displ(i)=i_ilist_sc(i-1)+displ(i-1)
27753 ! write(iout,*) "before gather",displ(0),displ(1)
27754 call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,&
27755 newcontlisti,i_ilist_sc,displ,MPI_INTEGER,&
27757 call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,&
27758 newcontlistj,i_ilist_sc,displ,MPI_INTEGER,&
27760 call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR)
27761 ! write(iout,*) "before bcast",g_ilist_sc
27762 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
27763 call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,IERR)
27764 call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,IERR)
27766 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
27769 g_ilist_sc=ilist_sc
27772 newcontlisti(i)=contlisti(i)
27773 newcontlistj(i)=contlistj(i)
27778 write (iout,*) "after MPIREDUCE",g_ilist_sc
27780 write (iout,*) i,newcontlisti(i),newcontlistj(i)
27783 call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
27785 end subroutine make_SCSC_inter_list
27786 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
27788 subroutine make_SCp_inter_list
27789 use MD_data, only: itime_mat
27792 real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
27793 real*8 :: dist_init, dist_temp,r_buff_list
27794 integer:: contlistscpi(350*nres),contlistscpj(350*nres)
27795 ! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres)
27796 integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_scp,g_ilist_scp
27797 integer displ(0:nprocs),i_ilist_scp(0:nprocs),ierr
27798 ! print *,"START make_SC"
27801 do i=iatscp_s,iatscp_e
27802 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
27803 xi=0.5D0*(c(1,i)+c(1,i+1))
27804 yi=0.5D0*(c(2,i)+c(2,i+1))
27805 zi=0.5D0*(c(3,i)+c(3,i+1))
27806 call to_box(xi,yi,zi)
27807 do iint=1,nscp_gr(i)
27809 do j=iscpstart(i,iint),iscpend(i,iint)
27810 itypj=iabs(itype(j,1))
27811 if (itypj.eq.ntyp1) cycle
27812 ! Uncomment following three lines for SC-p interactions
27813 ! xj=c(1,nres+j)-xi
27814 ! yj=c(2,nres+j)-yi
27815 ! zj=c(3,nres+j)-zi
27816 ! Uncomment following three lines for Ca-p interactions
27823 call to_box(xj,yj,zj)
27824 xj=boxshift(xj-xi,boxxsize)
27825 yj=boxshift(yj-yi,boxysize)
27826 zj=boxshift(zj-zi,boxzsize)
27827 dist_init=xj**2+yj**2+zj**2
27829 ! r_buff_list is a read value for a buffer
27830 if ((sqrt(dist_init).le.(r_cut_ele)).and.(ifirstrun.eq.0)) then
27831 ! Here the list is created
27832 ilist_scp_first=ilist_scp_first+1
27833 ! this can be substituted by cantor and anti-cantor
27834 contlistscpi_f(ilist_scp_first)=i
27835 contlistscpj_f(ilist_scp_first)=j
27838 ! r_buff_list is a read value for a buffer
27839 if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
27840 ! Here the list is created
27841 ilist_scp=ilist_scp+1
27842 ! this can be substituted by cantor and anti-cantor
27843 contlistscpi(ilist_scp)=i
27844 contlistscpj(ilist_scp)=j
27850 write (iout,*) "before MPIREDUCE",ilist_scp
27852 write (iout,*) i,contlistscpi(i),contlistscpj(i)
27855 if (nfgtasks.gt.1)then
27857 call MPI_Reduce(ilist_scp,g_ilist_scp,1,&
27858 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
27859 ! write(iout,*) "before bcast",g_ilist_sc
27860 call MPI_Gather(ilist_scp,1,MPI_INTEGER,&
27861 i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR)
27863 do i=1,nfgtasks-1,1
27864 displ(i)=i_ilist_scp(i-1)+displ(i-1)
27866 ! write(iout,*) "before gather",displ(0),displ(1)
27867 call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,&
27868 newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,&
27870 call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,&
27871 newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,&
27873 call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR)
27874 ! write(iout,*) "before bcast",g_ilist_sc
27875 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
27876 call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM,IERR)
27877 call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,IERR)
27879 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
27882 g_ilist_scp=ilist_scp
27885 newcontlistscpi(i)=contlistscpi(i)
27886 newcontlistscpj(i)=contlistscpj(i)
27891 write (iout,*) "after MPIREDUCE",g_ilist_scp
27893 write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
27896 ! if (ifirstrun.eq.0) ifirstrun=1
27897 ! do i=1,ilist_scp_first
27898 ! do j=1,g_ilist_scp
27899 ! if ((newcontlistscpi(j).eq.contlistscpi_f(i)).and.&
27900 ! (newcontlistscpj(j).eq.contlistscpj_f(i))) go to 126
27902 ! print *,itime_mat,"ERROR matrix needs updating"
27903 ! print *,contlistscpi_f(i),contlistscpj_f(i)
27907 call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
27910 end subroutine make_SCp_inter_list
27912 !-----------------------------------------------------------------------------
27913 !-----------------------------------------------------------------------------
27916 subroutine make_pp_inter_list
27918 real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
27919 real*8 :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj
27920 real*8 :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi
27921 real*8 :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj
27922 integer:: contlistppi(250*nres),contlistppj(250*nres)
27923 ! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
27924 integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_pp,g_ilist_pp
27925 integer displ(0:nprocs),i_ilist_pp(0:nprocs),ierr
27926 ! write(iout,*),"START make_pp",iatel_s,iatel_e,r_cut_ele+r_buff_list
27929 do i=iatel_s,iatel_e
27930 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
27934 dx_normi=dc_norm(1,i)
27935 dy_normi=dc_norm(2,i)
27936 dz_normi=dc_norm(3,i)
27937 xmedi=c(1,i)+0.5d0*dxi
27938 ymedi=c(2,i)+0.5d0*dyi
27939 zmedi=c(3,i)+0.5d0*dzi
27941 call to_box(xmedi,ymedi,zmedi)
27942 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
27943 ! write (iout,*) i,j,itype(i,1),itype(j,1)
27944 ! if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
27947 do j=ielstart(i),ielend(i)
27948 ! write (iout,*) i,j,itype(i,1),itype(j,1)
27949 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
27953 dx_normj=dc_norm(1,j)
27954 dy_normj=dc_norm(2,j)
27955 dz_normj=dc_norm(3,j)
27956 ! xj=c(1,j)+0.5D0*dxj-xmedi
27957 ! yj=c(2,j)+0.5D0*dyj-ymedi
27958 ! zj=c(3,j)+0.5D0*dzj-zmedi
27959 xj=c(1,j)+0.5D0*dxj
27960 yj=c(2,j)+0.5D0*dyj
27961 zj=c(3,j)+0.5D0*dzj
27962 call to_box(xj,yj,zj)
27963 ! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
27964 ! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
27965 xj=boxshift(xj-xmedi,boxxsize)
27966 yj=boxshift(yj-ymedi,boxysize)
27967 zj=boxshift(zj-zmedi,boxzsize)
27968 dist_init=xj**2+yj**2+zj**2
27969 if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
27970 ! Here the list is created
27971 ilist_pp=ilist_pp+1
27972 ! this can be substituted by cantor and anti-cantor
27973 contlistppi(ilist_pp)=i
27974 contlistppj(ilist_pp)=j
27980 write (iout,*) "before MPIREDUCE",ilist_pp
27982 write (iout,*) i,contlistppi(i),contlistppj(i)
27985 if (nfgtasks.gt.1)then
27987 call MPI_Reduce(ilist_pp,g_ilist_pp,1,&
27988 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
27989 ! write(iout,*) "before bcast",g_ilist_sc
27990 call MPI_Gather(ilist_pp,1,MPI_INTEGER,&
27991 i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR)
27993 do i=1,nfgtasks-1,1
27994 displ(i)=i_ilist_pp(i-1)+displ(i-1)
27996 ! write(iout,*) "before gather",displ(0),displ(1)
27997 call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER,&
27998 newcontlistppi,i_ilist_pp,displ,MPI_INTEGER,&
28000 call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER,&
28001 newcontlistppj,i_ilist_pp,displ,MPI_INTEGER,&
28003 call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR)
28004 ! write(iout,*) "before bcast",g_ilist_sc
28005 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
28006 call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM,IERR)
28007 call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,IERR)
28009 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
28012 g_ilist_pp=ilist_pp
28015 newcontlistppi(i)=contlistppi(i)
28016 newcontlistppj(i)=contlistppj(i)
28019 call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end)
28021 write (iout,*) "after MPIREDUCE",g_ilist_pp
28023 write (iout,*) i,newcontlistppi(i),newcontlistppj(i)
28027 end subroutine make_pp_inter_list
28029 !-----------------------------------------------------------------------------
28030 double precision function boxshift(x,boxsize)
28032 double precision x,boxsize
28033 double precision xtemp
28034 xtemp=dmod(x,boxsize)
28035 if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then
28036 boxshift=xtemp-boxsize
28037 else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then
28038 boxshift=xtemp+boxsize
28043 end function boxshift
28044 !-----------------------------------------------------------------------------
28045 subroutine to_box(xi,yi,zi)
28047 ! include 'DIMENSIONS'
28048 ! include 'COMMON.CHAIN'
28049 double precision xi,yi,zi
28050 xi=dmod(xi,boxxsize)
28051 if (xi.lt.0.0d0) xi=xi+boxxsize
28052 yi=dmod(yi,boxysize)
28053 if (yi.lt.0.0d0) yi=yi+boxysize
28054 zi=dmod(zi,boxzsize)
28055 if (zi.lt.0.0d0) zi=zi+boxzsize
28057 end subroutine to_box
28058 !--------------------------------------------------------------------------
28059 subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
28061 ! include 'DIMENSIONS'
28062 ! include 'COMMON.IOUNITS'
28063 ! include 'COMMON.CHAIN'
28064 double precision xi,yi,zi,sslipi,ssgradlipi
28065 double precision fracinbuf
28066 ! double precision sscalelip,sscagradlip
28068 write (iout,*) "bordlipbot",bordlipbot," bordliptop",bordliptop
28069 write (iout,*) "buflipbot",buflipbot," lipbufthick",lipbufthick
28070 write (iout,*) "xi yi zi",xi,yi,zi
28072 if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then
28073 ! the energy transfer exist
28074 if (zi.lt.buflipbot) then
28075 ! what fraction I am in
28076 fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick)
28077 ! lipbufthick is thickenes of lipid buffore
28078 sslipi=sscalelip(fracinbuf)
28079 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
28080 elseif (zi.gt.bufliptop) then
28081 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
28082 sslipi=sscalelip(fracinbuf)
28083 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
28093 write (iout,*) "sslipi",sslipi," ssgradlipi",ssgradlipi
28096 end subroutine lipid_layer
28098 !--------------------------------------------------------------------------
28099 !--------------------------------------------------------------------------