1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
47 C write(iout,*) 'po elektostatyce'
49 C Calculate electrostatic (H-bonding) energy of the main chain.
51 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C write(iout,*) 'po eelec'
54 C Calculate excluded-volume interaction energy between peptide groups
57 call escp(evdw2,evdw2_14)
59 c Calculate the bond-stretching energy
63 C write (iout,*) "estr",estr
65 C Calculate the disulfide-bridge and other energy and the contributions
66 C from other distance constraints.
67 cd print *,'Calling EHPB'
69 cd print *,'EHPB exitted succesfully.'
71 C Calculate the virtual-bond-angle energy.
74 C print *,'Bend energy finished.'
76 C Calculate the SC local energy.
79 C print *,'SCLOC energy finished.'
81 C Calculate the virtual-bond torsional energy.
83 cd print *,'nterm=',nterm
84 call etor(etors,edihcnstr,fact(1))
86 C 6/23/01 Calculate double-torsional energy
88 call etor_d(etors_d,fact(2))
90 C 21/5/07 Calculate local sicdechain correlation energy
92 call eback_sc_corr(esccor)
94 if (wliptran.gt.0) then
95 call Eliptransfer(eliptran)
99 C 12/1/95 Multi-body terms
103 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
104 & .or. wturn6.gt.0.0d0) then
105 c print *,"calling multibody_eello"
106 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
107 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
108 c print *,ecorr,ecorr5,ecorr6,eturn6
110 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
111 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
113 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
115 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
117 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
118 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
119 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
120 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
121 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
122 & +wbond*estr+wsccor*fact(1)*esccor+wliptran*eliptran
124 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
125 & +welec*fact(1)*(ees+evdw1)
126 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
127 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
128 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
129 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
130 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
131 & +wbond*estr+wsccor*fact(1)*esccor+wliptran*eliptran
136 energia(2)=evdw2-evdw2_14
153 energia(8)=eello_turn3
154 energia(9)=eello_turn4
163 energia(20)=edihcnstr
170 if (isnan(etot).ne.0) energia(0)=1.0d+99
172 if (isnan(etot)) energia(0)=1.0d+99
177 idumm=proc_proc(etot,i)
179 call proc_proc(etot,i)
181 if(i.eq.1)energia(0)=1.0d+99
188 C Sum up the components of the Cartesian gradient.
193 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
194 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
196 & wstrain*ghpbc(j,i)+
197 & wcorr*fact(3)*gradcorr(j,i)+
198 & wel_loc*fact(2)*gel_loc(j,i)+
199 & wturn3*fact(2)*gcorr3_turn(j,i)+
200 & wturn4*fact(3)*gcorr4_turn(j,i)+
201 & wcorr5*fact(4)*gradcorr5(j,i)+
202 & wcorr6*fact(5)*gradcorr6(j,i)+
203 & wturn6*fact(5)*gcorr6_turn(j,i)+
204 & wsccor*fact(2)*gsccorc(j,i)
205 & +wliptran*gliptranc(j,i)
206 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
208 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
209 & wsccor*fact(2)*gsccorx(j,i)
210 & +wliptran*gliptranx(j,i)
215 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
216 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
218 & wcorr*fact(3)*gradcorr(j,i)+
219 & wel_loc*fact(2)*gel_loc(j,i)+
220 & wturn3*fact(2)*gcorr3_turn(j,i)+
221 & wturn4*fact(3)*gcorr4_turn(j,i)+
222 & wcorr5*fact(4)*gradcorr5(j,i)+
223 & wcorr6*fact(5)*gradcorr6(j,i)+
224 & wturn6*fact(5)*gcorr6_turn(j,i)+
225 & wsccor*fact(2)*gsccorc(j,i)
226 & +wliptran*gliptranc(j,i)
227 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
229 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
230 & wsccor*fact(1)*gsccorx(j,i)
231 & +wliptran*gliptranx(j,i)
238 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
239 & +wcorr5*fact(4)*g_corr5_loc(i)
240 & +wcorr6*fact(5)*g_corr6_loc(i)
241 & +wturn4*fact(3)*gel_loc_turn4(i)
242 & +wturn3*fact(2)*gel_loc_turn3(i)
243 & +wturn6*fact(5)*gel_loc_turn6(i)
244 & +wel_loc*fact(2)*gel_loc_loc(i)
249 C------------------------------------------------------------------------
250 subroutine enerprint(energia,fact)
251 implicit real*8 (a-h,o-z)
253 include 'DIMENSIONS.ZSCOPT'
254 include 'COMMON.IOUNITS'
255 include 'COMMON.FFIELD'
256 include 'COMMON.SBRIDGE'
257 double precision energia(0:max_ene),fact(6)
259 evdw=energia(1)+fact(6)*energia(21)
261 evdw2=energia(2)+energia(17)
273 eello_turn3=energia(8)
274 eello_turn4=energia(9)
275 eello_turn6=energia(10)
282 edihcnstr=energia(20)
286 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
288 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
289 & etors_d,wtor_d*fact(2),ehpb,wstrain,
290 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
291 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
292 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
293 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,eliptran,wliptran,etot
294 10 format (/'Virtual-chain energies:'//
295 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
296 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
297 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
298 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
299 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
300 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
301 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
302 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
303 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
304 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
305 & ' (SS bridges & dist. cnstr.)'/
306 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
307 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
308 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
309 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
310 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
311 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
312 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
313 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
314 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
315 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
316 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
317 & 'ETOT= ',1pE16.6,' (total)')
319 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
320 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
321 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
322 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
323 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
324 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
325 & edihcnstr,ebr*nss,eliptran,wliptran,etot
326 10 format (/'Virtual-chain energies:'//
327 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
328 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
329 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
330 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
331 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
332 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
333 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
334 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
335 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
336 & ' (SS bridges & dist. cnstr.)'/
337 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
338 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
339 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
340 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
341 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
342 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
343 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
344 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
345 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
346 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
347 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
348 & 'ETOT= ',1pE16.6,' (total)')
352 C-----------------------------------------------------------------------
353 subroutine elj(evdw,evdw_t)
355 C This subroutine calculates the interaction energy of nonbonded side chains
356 C assuming the LJ potential of interaction.
358 implicit real*8 (a-h,o-z)
360 include 'DIMENSIONS.ZSCOPT'
361 include "DIMENSIONS.COMPAR"
362 parameter (accur=1.0d-10)
365 include 'COMMON.LOCAL'
366 include 'COMMON.CHAIN'
367 include 'COMMON.DERIV'
368 include 'COMMON.INTERACT'
369 include 'COMMON.TORSION'
370 include 'COMMON.ENEPS'
371 include 'COMMON.SBRIDGE'
372 include 'COMMON.NAMES'
373 include 'COMMON.IOUNITS'
374 include 'COMMON.CONTACTS'
378 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
381 eneps_temp(j,i)=0.0d0
388 if (itypi.eq.ntyp1) cycle
389 itypi1=iabs(itype(i+1))
396 C Calculate SC interaction energy.
399 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
400 cd & 'iend=',iend(i,iint)
401 do j=istart(i,iint),iend(i,iint)
403 if (itypj.eq.ntyp1) cycle
407 C Change 12/1/95 to calculate four-body interactions
408 rij=xj*xj+yj*yj+zj*zj
410 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
411 eps0ij=eps(itypi,itypj)
416 ij=icant(itypi,itypj)
417 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
418 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
419 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
420 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
421 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
422 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
423 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
424 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
425 if (bb.gt.0.0d0) then
432 C Calculate the components of the gradient in DC and X
434 fac=-rrij*(e1+evdwij)
439 gvdwx(k,i)=gvdwx(k,i)-gg(k)
440 gvdwx(k,j)=gvdwx(k,j)+gg(k)
444 gvdwc(l,k)=gvdwc(l,k)+gg(l)
449 C 12/1/95, revised on 5/20/97
451 C Calculate the contact function. The ith column of the array JCONT will
452 C contain the numbers of atoms that make contacts with the atom I (of numbers
453 C greater than I). The arrays FACONT and GACONT will contain the values of
454 C the contact function and its derivative.
456 C Uncomment next line, if the correlation interactions include EVDW explicitly.
457 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
458 C Uncomment next line, if the correlation interactions are contact function only
459 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
461 sigij=sigma(itypi,itypj)
462 r0ij=rs0(itypi,itypj)
464 C Check whether the SC's are not too far to make a contact.
467 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
468 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
470 if (fcont.gt.0.0D0) then
471 C If the SC-SC distance if close to sigma, apply spline.
472 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
473 cAdam & fcont1,fprimcont1)
474 cAdam fcont1=1.0d0-fcont1
475 cAdam if (fcont1.gt.0.0d0) then
476 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
477 cAdam fcont=fcont*fcont1
479 C Uncomment following 4 lines to have the geometric average of the epsilon0's
480 cga eps0ij=1.0d0/dsqrt(eps0ij)
482 cga gg(k)=gg(k)*eps0ij
484 cga eps0ij=-evdwij*eps0ij
485 C Uncomment for AL's type of SC correlation interactions.
487 num_conti=num_conti+1
489 facont(num_conti,i)=fcont*eps0ij
490 fprimcont=eps0ij*fprimcont/rij
492 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
493 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
494 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
495 C Uncomment following 3 lines for Skolnick's type of SC correlation.
496 gacont(1,num_conti,i)=-fprimcont*xj
497 gacont(2,num_conti,i)=-fprimcont*yj
498 gacont(3,num_conti,i)=-fprimcont*zj
499 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
500 cd write (iout,'(2i3,3f10.5)')
501 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
507 num_cont(i)=num_conti
512 gvdwc(j,i)=expon*gvdwc(j,i)
513 gvdwx(j,i)=expon*gvdwx(j,i)
517 C******************************************************************************
521 C To save time, the factor of EXPON has been extracted from ALL components
522 C of GVDWC and GRADX. Remember to multiply them by this factor before further
525 C******************************************************************************
528 C-----------------------------------------------------------------------------
529 subroutine eljk(evdw,evdw_t)
531 C This subroutine calculates the interaction energy of nonbonded side chains
532 C assuming the LJK potential of interaction.
534 implicit real*8 (a-h,o-z)
536 include 'DIMENSIONS.ZSCOPT'
537 include "DIMENSIONS.COMPAR"
540 include 'COMMON.LOCAL'
541 include 'COMMON.CHAIN'
542 include 'COMMON.DERIV'
543 include 'COMMON.INTERACT'
544 include 'COMMON.ENEPS'
545 include 'COMMON.IOUNITS'
546 include 'COMMON.NAMES'
551 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
554 eneps_temp(j,i)=0.0d0
561 if (itypi.eq.ntyp1) cycle
562 itypi1=iabs(itype(i+1))
567 C Calculate SC interaction energy.
570 do j=istart(i,iint),iend(i,iint)
572 if (itypj.eq.ntyp1) cycle
576 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
578 e_augm=augm(itypi,itypj)*fac_augm
581 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
582 fac=r_shift_inv**expon
586 ij=icant(itypi,itypj)
587 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
588 & /dabs(eps(itypi,itypj))
589 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
590 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
591 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
592 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
593 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
594 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
595 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
596 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
597 if (bb.gt.0.0d0) then
604 C Calculate the components of the gradient in DC and X
606 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
611 gvdwx(k,i)=gvdwx(k,i)-gg(k)
612 gvdwx(k,j)=gvdwx(k,j)+gg(k)
616 gvdwc(l,k)=gvdwc(l,k)+gg(l)
626 gvdwc(j,i)=expon*gvdwc(j,i)
627 gvdwx(j,i)=expon*gvdwx(j,i)
633 C-----------------------------------------------------------------------------
634 subroutine ebp(evdw,evdw_t)
636 C This subroutine calculates the interaction energy of nonbonded side chains
637 C assuming the Berne-Pechukas potential of interaction.
639 implicit real*8 (a-h,o-z)
641 include 'DIMENSIONS.ZSCOPT'
642 include "DIMENSIONS.COMPAR"
645 include 'COMMON.LOCAL'
646 include 'COMMON.CHAIN'
647 include 'COMMON.DERIV'
648 include 'COMMON.NAMES'
649 include 'COMMON.INTERACT'
650 include 'COMMON.ENEPS'
651 include 'COMMON.IOUNITS'
652 include 'COMMON.CALC'
654 c double precision rrsave(maxdim)
660 eneps_temp(j,i)=0.0d0
665 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
666 c if (icall.eq.0) then
674 if (itypi.eq.ntyp1) cycle
675 itypi1=iabs(itype(i+1))
679 dxi=dc_norm(1,nres+i)
680 dyi=dc_norm(2,nres+i)
681 dzi=dc_norm(3,nres+i)
682 dsci_inv=vbld_inv(i+nres)
684 C Calculate SC interaction energy.
687 do j=istart(i,iint),iend(i,iint)
690 if (itypj.eq.ntyp1) cycle
691 dscj_inv=vbld_inv(j+nres)
692 chi1=chi(itypi,itypj)
693 chi2=chi(itypj,itypi)
700 alf12=0.5D0*(alf1+alf2)
701 C For diagnostics only!!!
714 dxj=dc_norm(1,nres+j)
715 dyj=dc_norm(2,nres+j)
716 dzj=dc_norm(3,nres+j)
717 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
718 cd if (icall.eq.0) then
724 C Calculate the angle-dependent terms of energy & contributions to derivatives.
726 C Calculate whole angle-dependent part of epsilon and contributions
728 fac=(rrij*sigsq)**expon2
731 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
732 eps2der=evdwij*eps3rt
733 eps3der=evdwij*eps2rt
734 evdwij=evdwij*eps2rt*eps3rt
735 ij=icant(itypi,itypj)
736 aux=eps1*eps2rt**2*eps3rt**2
737 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
738 & /dabs(eps(itypi,itypj))
739 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
740 if (bb.gt.0.0d0) then
747 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
749 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
750 & restyp(itypi),i,restyp(itypj),j,
751 & epsi,sigm,chi1,chi2,chip1,chip2,
752 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
753 & om1,om2,om12,1.0D0/dsqrt(rrij),
756 C Calculate gradient components.
757 e1=e1*eps1*eps2rt**2*eps3rt**2
758 fac=-expon*(e1+evdwij)
761 C Calculate radial part of the gradient
765 C Calculate the angular part of the gradient and sum add the contributions
766 C to the appropriate components of the Cartesian gradient.
775 C-----------------------------------------------------------------------------
776 subroutine egb(evdw,evdw_t)
778 C This subroutine calculates the interaction energy of nonbonded side chains
779 C assuming the Gay-Berne potential of interaction.
781 implicit real*8 (a-h,o-z)
783 include 'DIMENSIONS.ZSCOPT'
784 include "DIMENSIONS.COMPAR"
787 include 'COMMON.LOCAL'
788 include 'COMMON.CHAIN'
789 include 'COMMON.DERIV'
790 include 'COMMON.NAMES'
791 include 'COMMON.INTERACT'
792 include 'COMMON.ENEPS'
793 include 'COMMON.IOUNITS'
794 include 'COMMON.CALC'
801 eneps_temp(j,i)=0.0d0
804 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
808 c if (icall.gt.0) lprn=.true.
812 if (itypi.eq.ntyp1) cycle
813 itypi1=iabs(itype(i+1))
817 C returning the ith atom to box
819 if (xi.lt.0) xi=xi+boxxsize
821 if (yi.lt.0) yi=yi+boxysize
823 if (zi.lt.0) zi=zi+boxzsize
824 if ((zi.gt.bordlipbot)
825 &.and.(zi.lt.bordliptop)) then
826 C the energy transfer exist
827 if (zi.lt.buflipbot) then
828 C what fraction I am in
830 & ((zi-bordlipbot)/lipbufthick)
831 C lipbufthick is thickenes of lipid buffore
832 sslipi=sscalelip(fracinbuf)
833 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
834 elseif (zi.gt.bufliptop) then
835 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
836 sslipi=sscalelip(fracinbuf)
837 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
847 dxi=dc_norm(1,nres+i)
848 dyi=dc_norm(2,nres+i)
849 dzi=dc_norm(3,nres+i)
850 dsci_inv=vbld_inv(i+nres)
852 C Calculate SC interaction energy.
855 do j=istart(i,iint),iend(i,iint)
858 if (itypj.eq.ntyp1) cycle
859 dscj_inv=vbld_inv(j+nres)
860 sig0ij=sigma(itypi,itypj)
861 chi1=chi(itypi,itypj)
862 chi2=chi(itypj,itypi)
869 alf12=0.5D0*(alf1+alf2)
870 C For diagnostics only!!!
883 C returning jth atom to box
885 if (xj.lt.0) xj=xj+boxxsize
887 if (yj.lt.0) yj=yj+boxysize
889 if (zj.lt.0) zj=zj+boxzsize
890 if ((zj.gt.bordlipbot)
891 &.and.(zj.lt.bordliptop)) then
892 C the energy transfer exist
893 if (zj.lt.buflipbot) then
894 C what fraction I am in
896 & ((zj-bordlipbot)/lipbufthick)
897 C lipbufthick is thickenes of lipid buffore
898 sslipj=sscalelip(fracinbuf)
899 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
900 elseif (zj.gt.bufliptop) then
901 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
902 sslipj=sscalelip(fracinbuf)
903 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
912 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
913 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
914 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
915 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
916 write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
917 C checking the distance
918 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
923 C finding the closest
927 xj=xj_safe+xshift*boxxsize
928 yj=yj_safe+yshift*boxysize
929 zj=zj_safe+zshift*boxzsize
930 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
931 if(dist_temp.lt.dist_init) then
941 if (subchap.eq.1) then
951 dxj=dc_norm(1,nres+j)
952 dyj=dc_norm(2,nres+j)
953 dzj=dc_norm(3,nres+j)
954 c write (iout,*) i,j,xj,yj,zj
955 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
957 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
958 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
959 if (sss.le.0.0) cycle
960 C Calculate angle-dependent terms of energy and contributions to their
965 sig=sig0ij*dsqrt(sigsq)
966 rij_shift=1.0D0/rij-sig+sig0ij
967 C I hate to put IF's in the loops, but here don't have another choice!!!!
968 if (rij_shift.le.0.0D0) then
973 c---------------------------------------------------------------
974 rij_shift=1.0D0/rij_shift
978 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
979 eps2der=evdwij*eps3rt
980 eps3der=evdwij*eps2rt
981 evdwij=evdwij*eps2rt*eps3rt
985 evdw_t=evdw_t+evdwij*sss
987 ij=icant(itypi,itypj)
988 aux=eps1*eps2rt**2*eps3rt**2
989 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
990 & /dabs(eps(itypi,itypj))
991 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
992 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
993 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
994 c & aux*e2/eps(itypi,itypj)
996 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
999 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1000 & restyp(itypi),i,restyp(itypj),j,
1001 & epsi,sigm,chi1,chi2,chip1,chip2,
1002 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1003 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1005 write (iout,*) "partial sum", evdw, evdw_t
1009 C Calculate gradient components.
1010 e1=e1*eps1*eps2rt**2*eps3rt**2
1011 fac=-expon*(e1+evdwij)*rij_shift
1014 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1015 C Calculate the radial part of the gradient
1019 C Calculate angular part of the gradient.
1027 C-----------------------------------------------------------------------------
1028 subroutine egbv(evdw,evdw_t)
1030 C This subroutine calculates the interaction energy of nonbonded side chains
1031 C assuming the Gay-Berne-Vorobjev potential of interaction.
1033 implicit real*8 (a-h,o-z)
1034 include 'DIMENSIONS'
1035 include 'DIMENSIONS.ZSCOPT'
1036 include "DIMENSIONS.COMPAR"
1037 include 'COMMON.GEO'
1038 include 'COMMON.VAR'
1039 include 'COMMON.LOCAL'
1040 include 'COMMON.CHAIN'
1041 include 'COMMON.DERIV'
1042 include 'COMMON.NAMES'
1043 include 'COMMON.INTERACT'
1044 include 'COMMON.ENEPS'
1045 include 'COMMON.IOUNITS'
1046 include 'COMMON.CALC'
1047 common /srutu/ icall
1053 eneps_temp(j,i)=0.0d0
1058 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1061 c if (icall.gt.0) lprn=.true.
1063 do i=iatsc_s,iatsc_e
1064 itypi=iabs(itype(i))
1065 if (itypi.eq.ntyp1) cycle
1066 itypi1=iabs(itype(i+1))
1070 dxi=dc_norm(1,nres+i)
1071 dyi=dc_norm(2,nres+i)
1072 dzi=dc_norm(3,nres+i)
1073 dsci_inv=vbld_inv(i+nres)
1075 C Calculate SC interaction energy.
1077 do iint=1,nint_gr(i)
1078 do j=istart(i,iint),iend(i,iint)
1080 itypj=iabs(itype(j))
1081 if (itypj.eq.ntyp1) cycle
1082 dscj_inv=vbld_inv(j+nres)
1083 sig0ij=sigma(itypi,itypj)
1084 r0ij=r0(itypi,itypj)
1085 chi1=chi(itypi,itypj)
1086 chi2=chi(itypj,itypi)
1093 alf12=0.5D0*(alf1+alf2)
1094 C For diagnostics only!!!
1107 dxj=dc_norm(1,nres+j)
1108 dyj=dc_norm(2,nres+j)
1109 dzj=dc_norm(3,nres+j)
1110 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1112 C Calculate angle-dependent terms of energy and contributions to their
1116 sig=sig0ij*dsqrt(sigsq)
1117 rij_shift=1.0D0/rij-sig+r0ij
1118 C I hate to put IF's in the loops, but here don't have another choice!!!!
1119 if (rij_shift.le.0.0D0) then
1124 c---------------------------------------------------------------
1125 rij_shift=1.0D0/rij_shift
1126 fac=rij_shift**expon
1129 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1130 eps2der=evdwij*eps3rt
1131 eps3der=evdwij*eps2rt
1132 fac_augm=rrij**expon
1133 e_augm=augm(itypi,itypj)*fac_augm
1134 evdwij=evdwij*eps2rt*eps3rt
1135 if (bb.gt.0.0d0) then
1136 evdw=evdw+evdwij+e_augm
1138 evdw_t=evdw_t+evdwij+e_augm
1140 ij=icant(itypi,itypj)
1141 aux=eps1*eps2rt**2*eps3rt**2
1142 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1143 & /dabs(eps(itypi,itypj))
1144 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1145 c eneps_temp(ij)=eneps_temp(ij)
1146 c & +(evdwij+e_augm)/eps(itypi,itypj)
1148 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1149 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1150 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1151 c & restyp(itypi),i,restyp(itypj),j,
1152 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1153 c & chi1,chi2,chip1,chip2,
1154 c & eps1,eps2rt**2,eps3rt**2,
1155 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1159 C Calculate gradient components.
1160 e1=e1*eps1*eps2rt**2*eps3rt**2
1161 fac=-expon*(e1+evdwij)*rij_shift
1163 fac=rij*fac-2*expon*rrij*e_augm
1164 C Calculate the radial part of the gradient
1168 C Calculate angular part of the gradient.
1176 C-----------------------------------------------------------------------------
1177 subroutine sc_angular
1178 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1179 C om12. Called by ebp, egb, and egbv.
1181 include 'COMMON.CALC'
1185 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1186 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1187 om12=dxi*dxj+dyi*dyj+dzi*dzj
1189 C Calculate eps1(om12) and its derivative in om12
1190 faceps1=1.0D0-om12*chiom12
1191 faceps1_inv=1.0D0/faceps1
1192 eps1=dsqrt(faceps1_inv)
1193 C Following variable is eps1*deps1/dom12
1194 eps1_om12=faceps1_inv*chiom12
1195 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1200 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1201 sigsq=1.0D0-facsig*faceps1_inv
1202 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1203 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1204 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1205 C Calculate eps2 and its derivatives in om1, om2, and om12.
1208 chipom12=chip12*om12
1209 facp=1.0D0-om12*chipom12
1211 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1212 C Following variable is the square root of eps2
1213 eps2rt=1.0D0-facp1*facp_inv
1214 C Following three variables are the derivatives of the square root of eps
1215 C in om1, om2, and om12.
1216 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1217 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1218 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1219 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1220 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1221 C Calculate whole angle-dependent part of epsilon and contributions
1222 C to its derivatives
1225 C----------------------------------------------------------------------------
1227 implicit real*8 (a-h,o-z)
1228 include 'DIMENSIONS'
1229 include 'DIMENSIONS.ZSCOPT'
1230 include 'COMMON.CHAIN'
1231 include 'COMMON.DERIV'
1232 include 'COMMON.CALC'
1233 double precision dcosom1(3),dcosom2(3)
1234 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1235 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1236 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1237 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1239 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1240 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1243 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1246 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1247 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1248 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1249 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1250 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1251 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1254 C Calculate the components of the gradient in DC and X
1258 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1263 c------------------------------------------------------------------------------
1264 subroutine vec_and_deriv
1265 implicit real*8 (a-h,o-z)
1266 include 'DIMENSIONS'
1267 include 'DIMENSIONS.ZSCOPT'
1268 include 'COMMON.IOUNITS'
1269 include 'COMMON.GEO'
1270 include 'COMMON.VAR'
1271 include 'COMMON.LOCAL'
1272 include 'COMMON.CHAIN'
1273 include 'COMMON.VECTORS'
1274 include 'COMMON.DERIV'
1275 include 'COMMON.INTERACT'
1276 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1277 C Compute the local reference systems. For reference system (i), the
1278 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1279 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1281 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1282 if (i.eq.nres-1) then
1283 C Case of the last full residue
1284 C Compute the Z-axis
1285 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1286 costh=dcos(pi-theta(nres))
1287 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1292 C Compute the derivatives of uz
1294 uzder(2,1,1)=-dc_norm(3,i-1)
1295 uzder(3,1,1)= dc_norm(2,i-1)
1296 uzder(1,2,1)= dc_norm(3,i-1)
1298 uzder(3,2,1)=-dc_norm(1,i-1)
1299 uzder(1,3,1)=-dc_norm(2,i-1)
1300 uzder(2,3,1)= dc_norm(1,i-1)
1303 uzder(2,1,2)= dc_norm(3,i)
1304 uzder(3,1,2)=-dc_norm(2,i)
1305 uzder(1,2,2)=-dc_norm(3,i)
1307 uzder(3,2,2)= dc_norm(1,i)
1308 uzder(1,3,2)= dc_norm(2,i)
1309 uzder(2,3,2)=-dc_norm(1,i)
1312 C Compute the Y-axis
1315 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1318 C Compute the derivatives of uy
1321 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1322 & -dc_norm(k,i)*dc_norm(j,i-1)
1323 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1325 uyder(j,j,1)=uyder(j,j,1)-costh
1326 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1331 uygrad(l,k,j,i)=uyder(l,k,j)
1332 uzgrad(l,k,j,i)=uzder(l,k,j)
1336 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1337 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1338 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1339 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1343 C Compute the Z-axis
1344 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1345 costh=dcos(pi-theta(i+2))
1346 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1351 C Compute the derivatives of uz
1353 uzder(2,1,1)=-dc_norm(3,i+1)
1354 uzder(3,1,1)= dc_norm(2,i+1)
1355 uzder(1,2,1)= dc_norm(3,i+1)
1357 uzder(3,2,1)=-dc_norm(1,i+1)
1358 uzder(1,3,1)=-dc_norm(2,i+1)
1359 uzder(2,3,1)= dc_norm(1,i+1)
1362 uzder(2,1,2)= dc_norm(3,i)
1363 uzder(3,1,2)=-dc_norm(2,i)
1364 uzder(1,2,2)=-dc_norm(3,i)
1366 uzder(3,2,2)= dc_norm(1,i)
1367 uzder(1,3,2)= dc_norm(2,i)
1368 uzder(2,3,2)=-dc_norm(1,i)
1371 C Compute the Y-axis
1374 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1377 C Compute the derivatives of uy
1380 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1381 & -dc_norm(k,i)*dc_norm(j,i+1)
1382 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1384 uyder(j,j,1)=uyder(j,j,1)-costh
1385 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1390 uygrad(l,k,j,i)=uyder(l,k,j)
1391 uzgrad(l,k,j,i)=uzder(l,k,j)
1395 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1396 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1397 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1398 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1404 vbld_inv_temp(1)=vbld_inv(i+1)
1405 if (i.lt.nres-1) then
1406 vbld_inv_temp(2)=vbld_inv(i+2)
1408 vbld_inv_temp(2)=vbld_inv(i)
1413 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1414 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1422 C-----------------------------------------------------------------------------
1423 subroutine vec_and_deriv_test
1424 implicit real*8 (a-h,o-z)
1425 include 'DIMENSIONS'
1426 include 'DIMENSIONS.ZSCOPT'
1427 include 'COMMON.IOUNITS'
1428 include 'COMMON.GEO'
1429 include 'COMMON.VAR'
1430 include 'COMMON.LOCAL'
1431 include 'COMMON.CHAIN'
1432 include 'COMMON.VECTORS'
1433 dimension uyder(3,3,2),uzder(3,3,2)
1434 C Compute the local reference systems. For reference system (i), the
1435 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1436 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1438 if (i.eq.nres-1) then
1439 C Case of the last full residue
1440 C Compute the Z-axis
1441 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1442 costh=dcos(pi-theta(nres))
1443 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1444 c write (iout,*) 'fac',fac,
1445 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1446 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1450 C Compute the derivatives of uz
1452 uzder(2,1,1)=-dc_norm(3,i-1)
1453 uzder(3,1,1)= dc_norm(2,i-1)
1454 uzder(1,2,1)= dc_norm(3,i-1)
1456 uzder(3,2,1)=-dc_norm(1,i-1)
1457 uzder(1,3,1)=-dc_norm(2,i-1)
1458 uzder(2,3,1)= dc_norm(1,i-1)
1461 uzder(2,1,2)= dc_norm(3,i)
1462 uzder(3,1,2)=-dc_norm(2,i)
1463 uzder(1,2,2)=-dc_norm(3,i)
1465 uzder(3,2,2)= dc_norm(1,i)
1466 uzder(1,3,2)= dc_norm(2,i)
1467 uzder(2,3,2)=-dc_norm(1,i)
1469 C Compute the Y-axis
1471 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1474 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1475 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1476 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1478 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1481 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1482 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1485 c write (iout,*) 'facy',facy,
1486 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1487 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1489 uy(k,i)=facy*uy(k,i)
1491 C Compute the derivatives of uy
1494 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1495 & -dc_norm(k,i)*dc_norm(j,i-1)
1496 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1498 c uyder(j,j,1)=uyder(j,j,1)-costh
1499 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1500 uyder(j,j,1)=uyder(j,j,1)
1501 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1502 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1508 uygrad(l,k,j,i)=uyder(l,k,j)
1509 uzgrad(l,k,j,i)=uzder(l,k,j)
1513 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1514 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1515 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1516 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1519 C Compute the Z-axis
1520 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1521 costh=dcos(pi-theta(i+2))
1522 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1523 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1527 C Compute the derivatives of uz
1529 uzder(2,1,1)=-dc_norm(3,i+1)
1530 uzder(3,1,1)= dc_norm(2,i+1)
1531 uzder(1,2,1)= dc_norm(3,i+1)
1533 uzder(3,2,1)=-dc_norm(1,i+1)
1534 uzder(1,3,1)=-dc_norm(2,i+1)
1535 uzder(2,3,1)= dc_norm(1,i+1)
1538 uzder(2,1,2)= dc_norm(3,i)
1539 uzder(3,1,2)=-dc_norm(2,i)
1540 uzder(1,2,2)=-dc_norm(3,i)
1542 uzder(3,2,2)= dc_norm(1,i)
1543 uzder(1,3,2)= dc_norm(2,i)
1544 uzder(2,3,2)=-dc_norm(1,i)
1546 C Compute the Y-axis
1548 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1549 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1550 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1552 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1555 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1556 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1559 c write (iout,*) 'facy',facy,
1560 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1561 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1563 uy(k,i)=facy*uy(k,i)
1565 C Compute the derivatives of uy
1568 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1569 & -dc_norm(k,i)*dc_norm(j,i+1)
1570 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1572 c uyder(j,j,1)=uyder(j,j,1)-costh
1573 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1574 uyder(j,j,1)=uyder(j,j,1)
1575 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1576 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1582 uygrad(l,k,j,i)=uyder(l,k,j)
1583 uzgrad(l,k,j,i)=uzder(l,k,j)
1587 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1588 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1589 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1590 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1597 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1598 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1605 C-----------------------------------------------------------------------------
1606 subroutine check_vecgrad
1607 implicit real*8 (a-h,o-z)
1608 include 'DIMENSIONS'
1609 include 'DIMENSIONS.ZSCOPT'
1610 include 'COMMON.IOUNITS'
1611 include 'COMMON.GEO'
1612 include 'COMMON.VAR'
1613 include 'COMMON.LOCAL'
1614 include 'COMMON.CHAIN'
1615 include 'COMMON.VECTORS'
1616 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1617 dimension uyt(3,maxres),uzt(3,maxres)
1618 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1619 double precision delta /1.0d-7/
1622 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1623 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1624 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1625 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1626 cd & (dc_norm(if90,i),if90=1,3)
1627 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1628 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1629 cd write(iout,'(a)')
1635 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1636 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1649 cd write (iout,*) 'i=',i
1651 erij(k)=dc_norm(k,i)
1655 dc_norm(k,i)=erij(k)
1657 dc_norm(j,i)=dc_norm(j,i)+delta
1658 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1660 c dc_norm(k,i)=dc_norm(k,i)/fac
1662 c write (iout,*) (dc_norm(k,i),k=1,3)
1663 c write (iout,*) (erij(k),k=1,3)
1666 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1667 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1668 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1669 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1671 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1672 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1673 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1676 dc_norm(k,i)=erij(k)
1679 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1680 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1681 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1682 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1683 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1684 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1685 cd write (iout,'(a)')
1690 C--------------------------------------------------------------------------
1691 subroutine set_matrices
1692 implicit real*8 (a-h,o-z)
1693 include 'DIMENSIONS'
1694 include 'DIMENSIONS.ZSCOPT'
1695 include 'COMMON.IOUNITS'
1696 include 'COMMON.GEO'
1697 include 'COMMON.VAR'
1698 include 'COMMON.LOCAL'
1699 include 'COMMON.CHAIN'
1700 include 'COMMON.DERIV'
1701 include 'COMMON.INTERACT'
1702 include 'COMMON.CONTACTS'
1703 include 'COMMON.TORSION'
1704 include 'COMMON.VECTORS'
1705 include 'COMMON.FFIELD'
1706 double precision auxvec(2),auxmat(2,2)
1708 C Compute the virtual-bond-torsional-angle dependent quantities needed
1709 C to calculate the el-loc multibody terms of various order.
1712 if (i .lt. nres+1) then
1749 if (i .gt. 3 .and. i .lt. nres+1) then
1750 obrot_der(1,i-2)=-sin1
1751 obrot_der(2,i-2)= cos1
1752 Ugder(1,1,i-2)= sin1
1753 Ugder(1,2,i-2)=-cos1
1754 Ugder(2,1,i-2)=-cos1
1755 Ugder(2,2,i-2)=-sin1
1758 obrot2_der(1,i-2)=-dwasin2
1759 obrot2_der(2,i-2)= dwacos2
1760 Ug2der(1,1,i-2)= dwasin2
1761 Ug2der(1,2,i-2)=-dwacos2
1762 Ug2der(2,1,i-2)=-dwacos2
1763 Ug2der(2,2,i-2)=-dwasin2
1765 obrot_der(1,i-2)=0.0d0
1766 obrot_der(2,i-2)=0.0d0
1767 Ugder(1,1,i-2)=0.0d0
1768 Ugder(1,2,i-2)=0.0d0
1769 Ugder(2,1,i-2)=0.0d0
1770 Ugder(2,2,i-2)=0.0d0
1771 obrot2_der(1,i-2)=0.0d0
1772 obrot2_der(2,i-2)=0.0d0
1773 Ug2der(1,1,i-2)=0.0d0
1774 Ug2der(1,2,i-2)=0.0d0
1775 Ug2der(2,1,i-2)=0.0d0
1776 Ug2der(2,2,i-2)=0.0d0
1778 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1779 if (itype(i-2).le.ntyp) then
1780 iti = itortyp(itype(i-2))
1787 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1788 if (itype(i-1).le.ntyp) then
1789 iti1 = itortyp(itype(i-1))
1796 cd write (iout,*) '*******i',i,' iti1',iti
1797 cd write (iout,*) 'b1',b1(:,iti)
1798 cd write (iout,*) 'b2',b2(:,iti)
1799 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1800 c print *,"itilde1 i iti iti1",i,iti,iti1
1801 if (i .gt. iatel_s+2) then
1802 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1803 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1804 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1805 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1806 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1807 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1808 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1818 DtUg2(l,k,i-2)=0.0d0
1822 c print *,"itilde2 i iti iti1",i,iti,iti1
1823 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1824 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1825 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1826 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1827 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1828 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1829 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1830 c print *,"itilde3 i iti iti1",i,iti,iti1
1832 muder(k,i-2)=Ub2der(k,i-2)
1834 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1835 if (itype(i-1).le.ntyp) then
1836 iti1 = itortyp(itype(i-1))
1844 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1846 C Vectors and matrices dependent on a single virtual-bond dihedral.
1847 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1848 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1849 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1850 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1851 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1852 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1853 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1854 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1855 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1856 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1857 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1859 C Matrices dependent on two consecutive virtual-bond dihedrals.
1860 C The order of matrices is from left to right.
1862 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1863 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1864 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1865 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1866 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1867 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1868 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1869 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1872 cd iti = itortyp(itype(i))
1875 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1876 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1881 C--------------------------------------------------------------------------
1882 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1884 C This subroutine calculates the average interaction energy and its gradient
1885 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1886 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1887 C The potential depends both on the distance of peptide-group centers and on
1888 C the orientation of the CA-CA virtual bonds.
1890 implicit real*8 (a-h,o-z)
1891 include 'DIMENSIONS'
1892 include 'DIMENSIONS.ZSCOPT'
1893 include 'COMMON.CONTROL'
1894 include 'COMMON.IOUNITS'
1895 include 'COMMON.GEO'
1896 include 'COMMON.VAR'
1897 include 'COMMON.LOCAL'
1898 include 'COMMON.CHAIN'
1899 include 'COMMON.DERIV'
1900 include 'COMMON.INTERACT'
1901 include 'COMMON.CONTACTS'
1902 include 'COMMON.TORSION'
1903 include 'COMMON.VECTORS'
1904 include 'COMMON.FFIELD'
1905 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1906 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1907 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1908 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1909 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1910 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1911 double precision scal_el /0.5d0/
1913 C 13-go grudnia roku pamietnego...
1914 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1915 & 0.0d0,1.0d0,0.0d0,
1916 & 0.0d0,0.0d0,1.0d0/
1917 cd write(iout,*) 'In EELEC'
1919 cd write(iout,*) 'Type',i
1920 cd write(iout,*) 'B1',B1(:,i)
1921 cd write(iout,*) 'B2',B2(:,i)
1922 cd write(iout,*) 'CC',CC(:,:,i)
1923 cd write(iout,*) 'DD',DD(:,:,i)
1924 cd write(iout,*) 'EE',EE(:,:,i)
1926 cd call check_vecgrad
1928 if (icheckgrad.eq.1) then
1930 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1932 dc_norm(k,i)=dc(k,i)*fac
1934 c write (iout,*) 'i',i,' fac',fac
1937 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1938 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1939 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1940 cd if (wel_loc.gt.0.0d0) then
1941 if (icheckgrad.eq.1) then
1942 call vec_and_deriv_test
1949 cd write (iout,*) 'i=',i
1951 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1954 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1955 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1968 C print '(a)','Enter EELEC'
1969 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1971 gel_loc_loc(i)=0.0d0
1974 do i=iatel_s,iatel_e
1976 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
1977 & .or. itype(i+2).eq.ntyp1) cycle
1979 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
1980 & .or. itype(i+2).eq.ntyp1
1981 & .or. itype(i-1).eq.ntyp1
1984 if (itel(i).eq.0) goto 1215
1988 dx_normi=dc_norm(1,i)
1989 dy_normi=dc_norm(2,i)
1990 dz_normi=dc_norm(3,i)
1991 xmedi=c(1,i)+0.5d0*dxi
1992 ymedi=c(2,i)+0.5d0*dyi
1993 zmedi=c(3,i)+0.5d0*dzi
1994 xmedi=mod(xmedi,boxxsize)
1995 if (xmedi.lt.0) xmedi=xmedi+boxxsize
1996 ymedi=mod(ymedi,boxysize)
1997 if (ymedi.lt.0) ymedi=ymedi+boxysize
1998 zmedi=mod(zmedi,boxzsize)
1999 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2001 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2002 do j=ielstart(i),ielend(i)
2004 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2005 & .or.itype(j+2).eq.ntyp1
2008 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2009 & .or.itype(j+2).eq.ntyp1
2010 & .or.itype(j-1).eq.ntyp1
2015 if (itel(j).eq.0) goto 1216
2019 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2020 aaa=app(iteli,itelj)
2021 bbb=bpp(iteli,itelj)
2022 C Diagnostics only!!!
2028 ael6i=ael6(iteli,itelj)
2029 ael3i=ael3(iteli,itelj)
2033 dx_normj=dc_norm(1,j)
2034 dy_normj=dc_norm(2,j)
2035 dz_normj=dc_norm(3,j)
2040 if (xj.lt.0) xj=xj+boxxsize
2042 if (yj.lt.0) yj=yj+boxysize
2044 if (zj.lt.0) zj=zj+boxzsize
2045 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2053 xj=xj_safe+xshift*boxxsize
2054 yj=yj_safe+yshift*boxysize
2055 zj=zj_safe+zshift*boxzsize
2056 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2057 if(dist_temp.lt.dist_init) then
2067 if (isubchap.eq.1) then
2076 rij=xj*xj+yj*yj+zj*zj
2077 sss=sscale(sqrt(rij))
2078 sssgrad=sscagrad(sqrt(rij))
2084 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2085 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2086 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2087 fac=cosa-3.0D0*cosb*cosg
2089 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2090 if (j.eq.i+2) ev1=scal_el*ev1
2095 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2098 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2099 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2100 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2102 evdw1=evdw1+evdwij*sss
2103 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2104 c &'evdw1',i,j,evdwij
2105 c &,iteli,itelj,aaa,evdw1
2107 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2108 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2109 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2110 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2111 c & xmedi,ymedi,zmedi,xj,yj,zj
2113 C Calculate contributions to the Cartesian gradient.
2116 facvdw=-6*rrmij*(ev1+evdwij)*sss
2117 facel=-3*rrmij*(el1+eesij)
2124 * Radial derivatives. First process both termini of the fragment (i,j)
2131 gelc(k,i)=gelc(k,i)+ghalf
2132 gelc(k,j)=gelc(k,j)+ghalf
2135 * Loop over residues i+1 thru j-1.
2139 gelc(l,k)=gelc(l,k)+ggg(l)
2145 if (sss.gt.0.0) then
2146 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2147 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2148 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2156 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2157 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2160 * Loop over residues i+1 thru j-1.
2164 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2168 facvdw=(ev1+evdwij)*sss
2171 fac=-3*rrmij*(facvdw+facvdw+facel)
2177 * Radial derivatives. First process both termini of the fragment (i,j)
2184 gelc(k,i)=gelc(k,i)+ghalf
2185 gelc(k,j)=gelc(k,j)+ghalf
2188 * Loop over residues i+1 thru j-1.
2192 gelc(l,k)=gelc(l,k)+ggg(l)
2199 ecosa=2.0D0*fac3*fac1+fac4
2202 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2203 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2205 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2206 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2208 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2209 cd & (dcosg(k),k=1,3)
2211 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2215 gelc(k,i)=gelc(k,i)+ghalf
2216 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2217 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2218 gelc(k,j)=gelc(k,j)+ghalf
2219 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2220 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2224 gelc(l,k)=gelc(l,k)+ggg(l)
2229 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2230 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2231 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2233 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2234 C energy of a peptide unit is assumed in the form of a second-order
2235 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2236 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2237 C are computed for EVERY pair of non-contiguous peptide groups.
2239 if (j.lt.nres-1) then
2250 muij(kkk)=mu(k,i)*mu(l,j)
2253 cd write (iout,*) 'EELEC: i',i,' j',j
2254 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2255 cd write(iout,*) 'muij',muij
2256 ury=scalar(uy(1,i),erij)
2257 urz=scalar(uz(1,i),erij)
2258 vry=scalar(uy(1,j),erij)
2259 vrz=scalar(uz(1,j),erij)
2260 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2261 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2262 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2263 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2264 C For diagnostics only
2269 fac=dsqrt(-ael6i)*r3ij
2270 cd write (2,*) 'fac=',fac
2271 C For diagnostics only
2277 cd write (iout,'(4i5,4f10.5)')
2278 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2279 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2280 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2281 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2282 cd write (iout,'(4f10.5)')
2283 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2284 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2285 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2286 cd write (iout,'(2i3,9f10.5/)') i,j,
2287 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2289 C Derivatives of the elements of A in virtual-bond vectors
2290 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2297 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2298 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2299 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2300 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2301 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2302 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2303 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2304 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2305 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2306 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2307 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2308 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2318 C Compute radial contributions to the gradient
2340 C Add the contributions coming from er
2343 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2344 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2345 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2346 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2349 C Derivatives in DC(i)
2350 ghalf1=0.5d0*agg(k,1)
2351 ghalf2=0.5d0*agg(k,2)
2352 ghalf3=0.5d0*agg(k,3)
2353 ghalf4=0.5d0*agg(k,4)
2354 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2355 & -3.0d0*uryg(k,2)*vry)+ghalf1
2356 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2357 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2358 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2359 & -3.0d0*urzg(k,2)*vry)+ghalf3
2360 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2361 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2362 C Derivatives in DC(i+1)
2363 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2364 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2365 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2366 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2367 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2368 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2369 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2370 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2371 C Derivatives in DC(j)
2372 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2373 & -3.0d0*vryg(k,2)*ury)+ghalf1
2374 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2375 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2376 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2377 & -3.0d0*vryg(k,2)*urz)+ghalf3
2378 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2379 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2380 C Derivatives in DC(j+1) or DC(nres-1)
2381 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2382 & -3.0d0*vryg(k,3)*ury)
2383 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2384 & -3.0d0*vrzg(k,3)*ury)
2385 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2386 & -3.0d0*vryg(k,3)*urz)
2387 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2388 & -3.0d0*vrzg(k,3)*urz)
2393 C Derivatives in DC(i+1)
2394 cd aggi1(k,1)=agg(k,1)
2395 cd aggi1(k,2)=agg(k,2)
2396 cd aggi1(k,3)=agg(k,3)
2397 cd aggi1(k,4)=agg(k,4)
2398 C Derivatives in DC(j)
2403 C Derivatives in DC(j+1)
2408 if (j.eq.nres-1 .and. i.lt.j-2) then
2410 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2411 cd aggj1(k,l)=agg(k,l)
2417 C Check the loc-el terms by numerical integration
2427 aggi(k,l)=-aggi(k,l)
2428 aggi1(k,l)=-aggi1(k,l)
2429 aggj(k,l)=-aggj(k,l)
2430 aggj1(k,l)=-aggj1(k,l)
2433 if (j.lt.nres-1) then
2439 aggi(k,l)=-aggi(k,l)
2440 aggi1(k,l)=-aggi1(k,l)
2441 aggj(k,l)=-aggj(k,l)
2442 aggj1(k,l)=-aggj1(k,l)
2453 aggi(k,l)=-aggi(k,l)
2454 aggi1(k,l)=-aggi1(k,l)
2455 aggj(k,l)=-aggj(k,l)
2456 aggj1(k,l)=-aggj1(k,l)
2462 IF (wel_loc.gt.0.0d0) THEN
2463 C Contribution to the local-electrostatic energy coming from the i-j pair
2464 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2466 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2467 c write (iout,'(a6,2i5,0pf7.3)')
2468 c & 'eelloc',i,j,eel_loc_ij
2469 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2470 eel_loc=eel_loc+eel_loc_ij
2471 C Partial derivatives in virtual-bond dihedral angles gamma
2474 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2475 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2476 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2477 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2478 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2479 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2480 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2481 cd write(iout,*) 'agg ',agg
2482 cd write(iout,*) 'aggi ',aggi
2483 cd write(iout,*) 'aggi1',aggi1
2484 cd write(iout,*) 'aggj ',aggj
2485 cd write(iout,*) 'aggj1',aggj1
2487 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2489 ggg(l)=agg(l,1)*muij(1)+
2490 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2494 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2497 C Remaining derivatives of eello
2499 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2500 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2501 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2502 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2503 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2504 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2505 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2506 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2510 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2511 C Contributions from turns
2516 call eturn34(i,j,eello_turn3,eello_turn4)
2518 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2519 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2521 C Calculate the contact function. The ith column of the array JCONT will
2522 C contain the numbers of atoms that make contacts with the atom I (of numbers
2523 C greater than I). The arrays FACONT and GACONT will contain the values of
2524 C the contact function and its derivative.
2525 c r0ij=1.02D0*rpp(iteli,itelj)
2526 c r0ij=1.11D0*rpp(iteli,itelj)
2527 r0ij=2.20D0*rpp(iteli,itelj)
2528 c r0ij=1.55D0*rpp(iteli,itelj)
2529 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2530 if (fcont.gt.0.0D0) then
2531 num_conti=num_conti+1
2532 if (num_conti.gt.maxconts) then
2533 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2534 & ' will skip next contacts for this conf.'
2536 jcont_hb(num_conti,i)=j
2537 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2538 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2539 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2541 d_cont(num_conti,i)=rij
2542 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2543 C --- Electrostatic-interaction matrix ---
2544 a_chuj(1,1,num_conti,i)=a22
2545 a_chuj(1,2,num_conti,i)=a23
2546 a_chuj(2,1,num_conti,i)=a32
2547 a_chuj(2,2,num_conti,i)=a33
2548 C --- Gradient of rij
2550 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2553 c a_chuj(1,1,num_conti,i)=-0.61d0
2554 c a_chuj(1,2,num_conti,i)= 0.4d0
2555 c a_chuj(2,1,num_conti,i)= 0.65d0
2556 c a_chuj(2,2,num_conti,i)= 0.50d0
2557 c else if (i.eq.2) then
2558 c a_chuj(1,1,num_conti,i)= 0.0d0
2559 c a_chuj(1,2,num_conti,i)= 0.0d0
2560 c a_chuj(2,1,num_conti,i)= 0.0d0
2561 c a_chuj(2,2,num_conti,i)= 0.0d0
2563 C --- and its gradients
2564 cd write (iout,*) 'i',i,' j',j
2566 cd write (iout,*) 'iii 1 kkk',kkk
2567 cd write (iout,*) agg(kkk,:)
2570 cd write (iout,*) 'iii 2 kkk',kkk
2571 cd write (iout,*) aggi(kkk,:)
2574 cd write (iout,*) 'iii 3 kkk',kkk
2575 cd write (iout,*) aggi1(kkk,:)
2578 cd write (iout,*) 'iii 4 kkk',kkk
2579 cd write (iout,*) aggj(kkk,:)
2582 cd write (iout,*) 'iii 5 kkk',kkk
2583 cd write (iout,*) aggj1(kkk,:)
2590 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2591 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2592 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2593 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2594 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2596 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2602 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2603 C Calculate contact energies
2605 wij=cosa-3.0D0*cosb*cosg
2608 c fac3=dsqrt(-ael6i)/r0ij**3
2609 fac3=dsqrt(-ael6i)*r3ij
2610 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2611 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2613 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2614 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2615 C Diagnostics. Comment out or remove after debugging!
2616 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2617 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2618 c ees0m(num_conti,i)=0.0D0
2620 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2621 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2622 facont_hb(num_conti,i)=fcont
2624 C Angular derivatives of the contact function
2625 ees0pij1=fac3/ees0pij
2626 ees0mij1=fac3/ees0mij
2627 fac3p=-3.0D0*fac3*rrmij
2628 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2629 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2631 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2632 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2633 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2634 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2635 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2636 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2637 ecosap=ecosa1+ecosa2
2638 ecosbp=ecosb1+ecosb2
2639 ecosgp=ecosg1+ecosg2
2640 ecosam=ecosa1-ecosa2
2641 ecosbm=ecosb1-ecosb2
2642 ecosgm=ecosg1-ecosg2
2651 fprimcont=fprimcont/rij
2652 cd facont_hb(num_conti,i)=1.0D0
2653 C Following line is for diagnostics.
2656 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2657 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2660 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2661 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2663 gggp(1)=gggp(1)+ees0pijp*xj
2664 gggp(2)=gggp(2)+ees0pijp*yj
2665 gggp(3)=gggp(3)+ees0pijp*zj
2666 gggm(1)=gggm(1)+ees0mijp*xj
2667 gggm(2)=gggm(2)+ees0mijp*yj
2668 gggm(3)=gggm(3)+ees0mijp*zj
2669 C Derivatives due to the contact function
2670 gacont_hbr(1,num_conti,i)=fprimcont*xj
2671 gacont_hbr(2,num_conti,i)=fprimcont*yj
2672 gacont_hbr(3,num_conti,i)=fprimcont*zj
2674 ghalfp=0.5D0*gggp(k)
2675 ghalfm=0.5D0*gggm(k)
2676 gacontp_hb1(k,num_conti,i)=ghalfp
2677 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2678 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2679 gacontp_hb2(k,num_conti,i)=ghalfp
2680 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2681 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2682 gacontp_hb3(k,num_conti,i)=gggp(k)
2683 gacontm_hb1(k,num_conti,i)=ghalfm
2684 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2685 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2686 gacontm_hb2(k,num_conti,i)=ghalfm
2687 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2688 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2689 gacontm_hb3(k,num_conti,i)=gggm(k)
2692 C Diagnostics. Comment out or remove after debugging!
2694 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2695 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2696 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2697 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2698 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2699 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2702 endif ! num_conti.le.maxconts
2707 num_cont_hb(i)=num_conti
2711 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2712 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2714 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2715 ccc eel_loc=eel_loc+eello_turn3
2718 C-----------------------------------------------------------------------------
2719 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2720 C Third- and fourth-order contributions from turns
2721 implicit real*8 (a-h,o-z)
2722 include 'DIMENSIONS'
2723 include 'DIMENSIONS.ZSCOPT'
2724 include 'COMMON.IOUNITS'
2725 include 'COMMON.GEO'
2726 include 'COMMON.VAR'
2727 include 'COMMON.LOCAL'
2728 include 'COMMON.CHAIN'
2729 include 'COMMON.DERIV'
2730 include 'COMMON.INTERACT'
2731 include 'COMMON.CONTACTS'
2732 include 'COMMON.TORSION'
2733 include 'COMMON.VECTORS'
2734 include 'COMMON.FFIELD'
2736 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2737 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2738 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2739 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2740 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2741 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2743 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2745 C Third-order contributions
2752 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2753 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2754 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2755 call transpose2(auxmat(1,1),auxmat1(1,1))
2756 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2757 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2758 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2759 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2760 cd & ' eello_turn3_num',4*eello_turn3_num
2762 C Derivatives in gamma(i)
2763 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2764 call transpose2(auxmat2(1,1),pizda(1,1))
2765 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2766 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2767 C Derivatives in gamma(i+1)
2768 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2769 call transpose2(auxmat2(1,1),pizda(1,1))
2770 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2771 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2772 & +0.5d0*(pizda(1,1)+pizda(2,2))
2773 C Cartesian derivatives
2775 a_temp(1,1)=aggi(l,1)
2776 a_temp(1,2)=aggi(l,2)
2777 a_temp(2,1)=aggi(l,3)
2778 a_temp(2,2)=aggi(l,4)
2779 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2780 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2781 & +0.5d0*(pizda(1,1)+pizda(2,2))
2782 a_temp(1,1)=aggi1(l,1)
2783 a_temp(1,2)=aggi1(l,2)
2784 a_temp(2,1)=aggi1(l,3)
2785 a_temp(2,2)=aggi1(l,4)
2786 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2787 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2788 & +0.5d0*(pizda(1,1)+pizda(2,2))
2789 a_temp(1,1)=aggj(l,1)
2790 a_temp(1,2)=aggj(l,2)
2791 a_temp(2,1)=aggj(l,3)
2792 a_temp(2,2)=aggj(l,4)
2793 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2794 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2795 & +0.5d0*(pizda(1,1)+pizda(2,2))
2796 a_temp(1,1)=aggj1(l,1)
2797 a_temp(1,2)=aggj1(l,2)
2798 a_temp(2,1)=aggj1(l,3)
2799 a_temp(2,2)=aggj1(l,4)
2800 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2801 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2802 & +0.5d0*(pizda(1,1)+pizda(2,2))
2805 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2806 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2808 C Fourth-order contributions
2816 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2817 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2818 iti1=itortyp(itype(i+1))
2819 iti2=itortyp(itype(i+2))
2820 iti3=itortyp(itype(i+3))
2821 call transpose2(EUg(1,1,i+1),e1t(1,1))
2822 call transpose2(Eug(1,1,i+2),e2t(1,1))
2823 call transpose2(Eug(1,1,i+3),e3t(1,1))
2824 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2825 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2826 s1=scalar2(b1(1,iti2),auxvec(1))
2827 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2828 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2829 s2=scalar2(b1(1,iti1),auxvec(1))
2830 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2831 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2832 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2833 eello_turn4=eello_turn4-(s1+s2+s3)
2834 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2835 cd & ' eello_turn4_num',8*eello_turn4_num
2836 C Derivatives in gamma(i)
2838 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2839 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2840 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2841 s1=scalar2(b1(1,iti2),auxvec(1))
2842 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2843 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2844 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2845 C Derivatives in gamma(i+1)
2846 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2847 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2848 s2=scalar2(b1(1,iti1),auxvec(1))
2849 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2850 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2851 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2852 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2853 C Derivatives in gamma(i+2)
2854 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2855 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2856 s1=scalar2(b1(1,iti2),auxvec(1))
2857 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2858 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2859 s2=scalar2(b1(1,iti1),auxvec(1))
2860 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2861 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2862 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2863 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2864 C Cartesian derivatives
2865 C Derivatives of this turn contributions in DC(i+2)
2866 if (j.lt.nres-1) then
2868 a_temp(1,1)=agg(l,1)
2869 a_temp(1,2)=agg(l,2)
2870 a_temp(2,1)=agg(l,3)
2871 a_temp(2,2)=agg(l,4)
2872 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2873 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2874 s1=scalar2(b1(1,iti2),auxvec(1))
2875 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2876 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2877 s2=scalar2(b1(1,iti1),auxvec(1))
2878 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2879 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2880 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2882 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2885 C Remaining derivatives of this turn contribution
2887 a_temp(1,1)=aggi(l,1)
2888 a_temp(1,2)=aggi(l,2)
2889 a_temp(2,1)=aggi(l,3)
2890 a_temp(2,2)=aggi(l,4)
2891 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2892 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2893 s1=scalar2(b1(1,iti2),auxvec(1))
2894 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2895 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2896 s2=scalar2(b1(1,iti1),auxvec(1))
2897 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2898 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2899 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2900 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2901 a_temp(1,1)=aggi1(l,1)
2902 a_temp(1,2)=aggi1(l,2)
2903 a_temp(2,1)=aggi1(l,3)
2904 a_temp(2,2)=aggi1(l,4)
2905 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2906 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2907 s1=scalar2(b1(1,iti2),auxvec(1))
2908 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2909 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2910 s2=scalar2(b1(1,iti1),auxvec(1))
2911 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2912 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2913 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2914 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2915 a_temp(1,1)=aggj(l,1)
2916 a_temp(1,2)=aggj(l,2)
2917 a_temp(2,1)=aggj(l,3)
2918 a_temp(2,2)=aggj(l,4)
2919 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2920 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2921 s1=scalar2(b1(1,iti2),auxvec(1))
2922 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2923 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2924 s2=scalar2(b1(1,iti1),auxvec(1))
2925 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2926 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2927 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2928 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2929 a_temp(1,1)=aggj1(l,1)
2930 a_temp(1,2)=aggj1(l,2)
2931 a_temp(2,1)=aggj1(l,3)
2932 a_temp(2,2)=aggj1(l,4)
2933 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2934 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2935 s1=scalar2(b1(1,iti2),auxvec(1))
2936 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2937 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2938 s2=scalar2(b1(1,iti1),auxvec(1))
2939 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2940 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2941 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2942 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2948 C-----------------------------------------------------------------------------
2949 subroutine vecpr(u,v,w)
2950 implicit real*8(a-h,o-z)
2951 dimension u(3),v(3),w(3)
2952 w(1)=u(2)*v(3)-u(3)*v(2)
2953 w(2)=-u(1)*v(3)+u(3)*v(1)
2954 w(3)=u(1)*v(2)-u(2)*v(1)
2957 C-----------------------------------------------------------------------------
2958 subroutine unormderiv(u,ugrad,unorm,ungrad)
2959 C This subroutine computes the derivatives of a normalized vector u, given
2960 C the derivatives computed without normalization conditions, ugrad. Returns
2963 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2964 double precision vec(3)
2965 double precision scalar
2967 c write (2,*) 'ugrad',ugrad
2970 vec(i)=scalar(ugrad(1,i),u(1))
2972 c write (2,*) 'vec',vec
2975 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2978 c write (2,*) 'ungrad',ungrad
2981 C-----------------------------------------------------------------------------
2982 subroutine escp(evdw2,evdw2_14)
2984 C This subroutine calculates the excluded-volume interaction energy between
2985 C peptide-group centers and side chains and its gradient in virtual-bond and
2986 C side-chain vectors.
2988 implicit real*8 (a-h,o-z)
2989 include 'DIMENSIONS'
2990 include 'DIMENSIONS.ZSCOPT'
2991 include 'COMMON.GEO'
2992 include 'COMMON.VAR'
2993 include 'COMMON.LOCAL'
2994 include 'COMMON.CHAIN'
2995 include 'COMMON.DERIV'
2996 include 'COMMON.INTERACT'
2997 include 'COMMON.FFIELD'
2998 include 'COMMON.IOUNITS'
3002 cd print '(a)','Enter ESCP'
3003 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3004 c & ' scal14',scal14
3005 do i=iatscp_s,iatscp_e
3006 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3008 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3009 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3010 if (iteli.eq.0) goto 1225
3011 xi=0.5D0*(c(1,i)+c(1,i+1))
3012 yi=0.5D0*(c(2,i)+c(2,i+1))
3013 zi=0.5D0*(c(3,i)+c(3,i+1))
3014 C Returning the ith atom to box
3016 if (xi.lt.0) xi=xi+boxxsize
3018 if (yi.lt.0) yi=yi+boxysize
3020 if (zi.lt.0) zi=zi+boxzsize
3021 do iint=1,nscp_gr(i)
3023 do j=iscpstart(i,iint),iscpend(i,iint)
3024 itypj=iabs(itype(j))
3025 if (itypj.eq.ntyp1) cycle
3026 C Uncomment following three lines for SC-p interactions
3030 C Uncomment following three lines for Ca-p interactions
3034 C returning the jth atom to box
3036 if (xj.lt.0) xj=xj+boxxsize
3038 if (yj.lt.0) yj=yj+boxysize
3040 if (zj.lt.0) zj=zj+boxzsize
3041 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3046 C Finding the closest jth atom
3050 xj=xj_safe+xshift*boxxsize
3051 yj=yj_safe+yshift*boxysize
3052 zj=zj_safe+zshift*boxzsize
3053 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3054 if(dist_temp.lt.dist_init) then
3064 if (subchap.eq.1) then
3073 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3074 C sss is scaling function for smoothing the cutoff gradient otherwise
3075 C the gradient would not be continuouse
3076 sss=sscale(1.0d0/(dsqrt(rrij)))
3077 if (sss.le.0.0d0) cycle
3078 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3080 e1=fac*fac*aad(itypj,iteli)
3081 e2=fac*bad(itypj,iteli)
3082 if (iabs(j-i) .le. 2) then
3085 evdw2_14=evdw2_14+(e1+e2)*sss
3088 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3089 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3090 c & bad(itypj,iteli)
3091 evdw2=evdw2+evdwij*sss
3094 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3096 fac=-(evdwij+e1)*rrij*sss
3097 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3102 cd write (iout,*) 'j<i'
3103 C Uncomment following three lines for SC-p interactions
3105 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3108 cd write (iout,*) 'j>i'
3111 C Uncomment following line for SC-p interactions
3112 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3116 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3120 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3121 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3124 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3134 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3135 gradx_scp(j,i)=expon*gradx_scp(j,i)
3138 C******************************************************************************
3142 C To save time the factor EXPON has been extracted from ALL components
3143 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3146 C******************************************************************************
3149 C--------------------------------------------------------------------------
3150 subroutine edis(ehpb)
3152 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3154 implicit real*8 (a-h,o-z)
3155 include 'DIMENSIONS'
3156 include 'DIMENSIONS.ZSCOPT'
3157 include 'COMMON.SBRIDGE'
3158 include 'COMMON.CHAIN'
3159 include 'COMMON.DERIV'
3160 include 'COMMON.VAR'
3161 include 'COMMON.INTERACT'
3164 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3165 cd print *,'link_start=',link_start,' link_end=',link_end
3166 if (link_end.eq.0) return
3167 do i=link_start,link_end
3168 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3169 C CA-CA distance used in regularization of structure.
3172 C iii and jjj point to the residues for which the distance is assigned.
3173 if (ii.gt.nres) then
3180 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3181 C distance and angle dependent SS bond potential.
3182 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3183 & iabs(itype(jjj)).eq.1) then
3184 call ssbond_ene(iii,jjj,eij)
3187 C Calculate the distance between the two points and its difference from the
3191 C Get the force constant corresponding to this distance.
3193 C Calculate the contribution to energy.
3194 ehpb=ehpb+waga*rdis*rdis
3196 C Evaluate gradient.
3199 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3200 cd & ' waga=',waga,' fac=',fac
3202 ggg(j)=fac*(c(j,jj)-c(j,ii))
3204 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3205 C If this is a SC-SC distance, we need to calculate the contributions to the
3206 C Cartesian gradient in the SC vectors (ghpbx).
3209 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3210 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3215 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3223 C--------------------------------------------------------------------------
3224 subroutine ssbond_ene(i,j,eij)
3226 C Calculate the distance and angle dependent SS-bond potential energy
3227 C using a free-energy function derived based on RHF/6-31G** ab initio
3228 C calculations of diethyl disulfide.
3230 C A. Liwo and U. Kozlowska, 11/24/03
3232 implicit real*8 (a-h,o-z)
3233 include 'DIMENSIONS'
3234 include 'DIMENSIONS.ZSCOPT'
3235 include 'COMMON.SBRIDGE'
3236 include 'COMMON.CHAIN'
3237 include 'COMMON.DERIV'
3238 include 'COMMON.LOCAL'
3239 include 'COMMON.INTERACT'
3240 include 'COMMON.VAR'
3241 include 'COMMON.IOUNITS'
3242 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3243 itypi=iabs(itype(i))
3247 dxi=dc_norm(1,nres+i)
3248 dyi=dc_norm(2,nres+i)
3249 dzi=dc_norm(3,nres+i)
3250 dsci_inv=dsc_inv(itypi)
3251 itypj=iabs(itype(j))
3252 dscj_inv=dsc_inv(itypj)
3256 dxj=dc_norm(1,nres+j)
3257 dyj=dc_norm(2,nres+j)
3258 dzj=dc_norm(3,nres+j)
3259 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3264 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3265 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3266 om12=dxi*dxj+dyi*dyj+dzi*dzj
3268 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3269 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3275 deltat12=om2-om1+2.0d0
3277 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3278 & +akct*deltad*deltat12
3279 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3280 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3281 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3282 c & " deltat12",deltat12," eij",eij
3283 ed=2*akcm*deltad+akct*deltat12
3285 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3286 eom1=-2*akth*deltat1-pom1-om2*pom2
3287 eom2= 2*akth*deltat2+pom1-om1*pom2
3290 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3293 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3294 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3295 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3296 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3299 C Calculate the components of the gradient in DC and X
3303 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3308 C--------------------------------------------------------------------------
3309 subroutine ebond(estr)
3311 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3313 implicit real*8 (a-h,o-z)
3314 include 'DIMENSIONS'
3315 include 'DIMENSIONS.ZSCOPT'
3316 include 'COMMON.LOCAL'
3317 include 'COMMON.GEO'
3318 include 'COMMON.INTERACT'
3319 include 'COMMON.DERIV'
3320 include 'COMMON.VAR'
3321 include 'COMMON.CHAIN'
3322 include 'COMMON.IOUNITS'
3323 include 'COMMON.NAMES'
3324 include 'COMMON.FFIELD'
3325 include 'COMMON.CONTROL'
3326 logical energy_dec /.false./
3327 double precision u(3),ud(3)
3330 c write (iout,*) "distchainmax",distchainmax
3332 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3333 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3335 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3336 C & *dc(j,i-1)/vbld(i)
3338 C if (energy_dec) write(iout,*)
3339 C & "estr1",i,vbld(i),distchainmax,
3340 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3342 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3343 diff = vbld(i)-vbldpDUM
3345 diff = vbld(i)-vbldp0
3346 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3350 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3353 C write (iout,'(a7,i5,4f7.3)')
3354 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3356 estr=0.5d0*AKP*estr+estr1
3358 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3362 if (iti.ne.10 .and. iti.ne.ntyp1) then
3365 diff=vbld(i+nres)-vbldsc0(1,iti)
3366 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3367 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3368 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3370 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3374 diff=vbld(i+nres)-vbldsc0(j,iti)
3375 ud(j)=aksc(j,iti)*diff
3376 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3390 uprod2=uprod2*u(k)*u(k)
3394 usumsqder=usumsqder+ud(j)*uprod2
3396 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3397 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3398 estr=estr+uprod/usum
3400 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3408 C--------------------------------------------------------------------------
3409 subroutine ebend(etheta)
3411 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3412 C angles gamma and its derivatives in consecutive thetas and gammas.
3414 implicit real*8 (a-h,o-z)
3415 include 'DIMENSIONS'
3416 include 'DIMENSIONS.ZSCOPT'
3417 include 'COMMON.LOCAL'
3418 include 'COMMON.GEO'
3419 include 'COMMON.INTERACT'
3420 include 'COMMON.DERIV'
3421 include 'COMMON.VAR'
3422 include 'COMMON.CHAIN'
3423 include 'COMMON.IOUNITS'
3424 include 'COMMON.NAMES'
3425 include 'COMMON.FFIELD'
3426 common /calcthet/ term1,term2,termm,diffak,ratak,
3427 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3428 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3429 double precision y(2),z(2)
3431 time11=dexp(-2*time)
3434 c write (iout,*) "nres",nres
3435 c write (*,'(a,i2)') 'EBEND ICG=',icg
3436 c write (iout,*) ithet_start,ithet_end
3437 do i=ithet_start,ithet_end
3438 C if (itype(i-1).eq.ntyp1) cycle
3440 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3441 & .or.itype(i).eq.ntyp1) cycle
3442 C Zero the energy function and its derivative at 0 or pi.
3443 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3445 ichir1=isign(1,itype(i-2))
3446 ichir2=isign(1,itype(i))
3447 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3448 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3449 if (itype(i-1).eq.10) then
3450 itype1=isign(10,itype(i-2))
3451 ichir11=isign(1,itype(i-2))
3452 ichir12=isign(1,itype(i-2))
3453 itype2=isign(10,itype(i))
3454 ichir21=isign(1,itype(i))
3455 ichir22=isign(1,itype(i))
3462 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3466 call proc_proc(phii,icrc)
3467 if (icrc.eq.1) phii=150.0
3478 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3482 call proc_proc(phii1,icrc)
3483 if (icrc.eq.1) phii1=150.0
3495 C Calculate the "mean" value of theta from the part of the distribution
3496 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3497 C In following comments this theta will be referred to as t_c.
3498 thet_pred_mean=0.0d0
3500 athetk=athet(k,it,ichir1,ichir2)
3501 bthetk=bthet(k,it,ichir1,ichir2)
3503 athetk=athet(k,itype1,ichir11,ichir12)
3504 bthetk=bthet(k,itype2,ichir21,ichir22)
3506 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3508 c write (iout,*) "thet_pred_mean",thet_pred_mean
3509 dthett=thet_pred_mean*ssd
3510 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3511 c write (iout,*) "thet_pred_mean",thet_pred_mean
3512 C Derivatives of the "mean" values in gamma1 and gamma2.
3513 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3514 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3515 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3516 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3518 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3519 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3520 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3521 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3523 if (theta(i).gt.pi-delta) then
3524 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3526 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3527 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3528 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3530 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3532 else if (theta(i).lt.delta) then
3533 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3534 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3535 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3537 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3538 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3541 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3544 etheta=etheta+ethetai
3545 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
3546 c & 'ebend',i,ethetai,theta(i),itype(i)
3547 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3548 c & rad2deg*phii,rad2deg*phii1,ethetai
3549 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3550 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3551 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3554 C Ufff.... We've done all this!!!
3557 C---------------------------------------------------------------------------
3558 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3560 implicit real*8 (a-h,o-z)
3561 include 'DIMENSIONS'
3562 include 'COMMON.LOCAL'
3563 include 'COMMON.IOUNITS'
3564 common /calcthet/ term1,term2,termm,diffak,ratak,
3565 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3566 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3567 C Calculate the contributions to both Gaussian lobes.
3568 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3569 C The "polynomial part" of the "standard deviation" of this part of
3573 sig=sig*thet_pred_mean+polthet(j,it)
3575 C Derivative of the "interior part" of the "standard deviation of the"
3576 C gamma-dependent Gaussian lobe in t_c.
3577 sigtc=3*polthet(3,it)
3579 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3582 C Set the parameters of both Gaussian lobes of the distribution.
3583 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3584 fac=sig*sig+sigc0(it)
3587 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3588 sigsqtc=-4.0D0*sigcsq*sigtc
3589 c print *,i,sig,sigtc,sigsqtc
3590 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3591 sigtc=-sigtc/(fac*fac)
3592 C Following variable is sigma(t_c)**(-2)
3593 sigcsq=sigcsq*sigcsq
3595 sig0inv=1.0D0/sig0i**2
3596 delthec=thetai-thet_pred_mean
3597 delthe0=thetai-theta0i
3598 term1=-0.5D0*sigcsq*delthec*delthec
3599 term2=-0.5D0*sig0inv*delthe0*delthe0
3600 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3601 C NaNs in taking the logarithm. We extract the largest exponent which is added
3602 C to the energy (this being the log of the distribution) at the end of energy
3603 C term evaluation for this virtual-bond angle.
3604 if (term1.gt.term2) then
3606 term2=dexp(term2-termm)
3610 term1=dexp(term1-termm)
3613 C The ratio between the gamma-independent and gamma-dependent lobes of
3614 C the distribution is a Gaussian function of thet_pred_mean too.
3615 diffak=gthet(2,it)-thet_pred_mean
3616 ratak=diffak/gthet(3,it)**2
3617 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3618 C Let's differentiate it in thet_pred_mean NOW.
3620 C Now put together the distribution terms to make complete distribution.
3621 termexp=term1+ak*term2
3622 termpre=sigc+ak*sig0i
3623 C Contribution of the bending energy from this theta is just the -log of
3624 C the sum of the contributions from the two lobes and the pre-exponential
3625 C factor. Simple enough, isn't it?
3626 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3627 C NOW the derivatives!!!
3628 C 6/6/97 Take into account the deformation.
3629 E_theta=(delthec*sigcsq*term1
3630 & +ak*delthe0*sig0inv*term2)/termexp
3631 E_tc=((sigtc+aktc*sig0i)/termpre
3632 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3633 & aktc*term2)/termexp)
3636 c-----------------------------------------------------------------------------
3637 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3638 implicit real*8 (a-h,o-z)
3639 include 'DIMENSIONS'
3640 include 'COMMON.LOCAL'
3641 include 'COMMON.IOUNITS'
3642 common /calcthet/ term1,term2,termm,diffak,ratak,
3643 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3644 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3645 delthec=thetai-thet_pred_mean
3646 delthe0=thetai-theta0i
3647 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3648 t3 = thetai-thet_pred_mean
3652 t14 = t12+t6*sigsqtc
3654 t21 = thetai-theta0i
3660 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3661 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3662 & *(-t12*t9-ak*sig0inv*t27)
3666 C--------------------------------------------------------------------------
3667 subroutine ebend(etheta)
3669 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3670 C angles gamma and its derivatives in consecutive thetas and gammas.
3671 C ab initio-derived potentials from
3672 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3674 implicit real*8 (a-h,o-z)
3675 include 'DIMENSIONS'
3676 include 'DIMENSIONS.ZSCOPT'
3677 include 'COMMON.LOCAL'
3678 include 'COMMON.GEO'
3679 include 'COMMON.INTERACT'
3680 include 'COMMON.DERIV'
3681 include 'COMMON.VAR'
3682 include 'COMMON.CHAIN'
3683 include 'COMMON.IOUNITS'
3684 include 'COMMON.NAMES'
3685 include 'COMMON.FFIELD'
3686 include 'COMMON.CONTROL'
3687 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3688 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3689 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3690 & sinph1ph2(maxdouble,maxdouble)
3691 logical lprn /.false./, lprn1 /.false./
3693 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3694 do i=ithet_start,ithet_end
3696 C if (itype(i-1).eq.ntyp1) cycle
3698 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3699 & .or.itype(i).eq.ntyp1) cycle
3700 if (iabs(itype(i+1)).eq.20) iblock=2
3701 if (iabs(itype(i+1)).ne.20) iblock=1
3705 theti2=0.5d0*theta(i)
3706 ityp2=ithetyp((itype(i-1)))
3708 coskt(k)=dcos(k*theti2)
3709 sinkt(k)=dsin(k*theti2)
3719 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3722 if (phii.ne.phii) phii=150.0
3726 ityp1=ithetyp((itype(i-2)))
3728 cosph1(k)=dcos(k*phii)
3729 sinph1(k)=dsin(k*phii)
3740 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3743 if (phii1.ne.phii1) phii1=150.0
3748 ityp3=ithetyp((itype(i)))
3750 cosph2(k)=dcos(k*phii1)
3751 sinph2(k)=dsin(k*phii1)
3761 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3762 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3764 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3767 ccl=cosph1(l)*cosph2(k-l)
3768 ssl=sinph1(l)*sinph2(k-l)
3769 scl=sinph1(l)*cosph2(k-l)
3770 csl=cosph1(l)*sinph2(k-l)
3771 cosph1ph2(l,k)=ccl-ssl
3772 cosph1ph2(k,l)=ccl+ssl
3773 sinph1ph2(l,k)=scl+csl
3774 sinph1ph2(k,l)=scl-csl
3778 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3779 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3780 write (iout,*) "coskt and sinkt"
3782 write (iout,*) k,coskt(k),sinkt(k)
3786 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3787 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3790 & write (iout,*) "k",k,"
3791 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3792 & " ethetai",ethetai
3795 write (iout,*) "cosph and sinph"
3797 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3799 write (iout,*) "cosph1ph2 and sinph2ph2"
3802 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3803 & sinph1ph2(l,k),sinph1ph2(k,l)
3806 write(iout,*) "ethetai",ethetai
3810 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3811 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3812 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3813 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3814 ethetai=ethetai+sinkt(m)*aux
3815 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3816 dephii=dephii+k*sinkt(m)*(
3817 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3818 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3819 dephii1=dephii1+k*sinkt(m)*(
3820 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3821 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3823 & write (iout,*) "m",m," k",k," bbthet",
3824 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3825 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3826 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3827 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3831 & write(iout,*) "ethetai",ethetai
3835 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3836 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3837 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3838 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3839 ethetai=ethetai+sinkt(m)*aux
3840 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3841 dephii=dephii+l*sinkt(m)*(
3842 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3843 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3844 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3845 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3846 dephii1=dephii1+(k-l)*sinkt(m)*(
3847 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3848 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3849 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3850 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3852 write (iout,*) "m",m," k",k," l",l," ffthet",
3853 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3854 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3855 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3856 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3857 & " ethetai",ethetai
3858 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3859 & cosph1ph2(k,l)*sinkt(m),
3860 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3866 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3867 & i,theta(i)*rad2deg,phii*rad2deg,
3868 & phii1*rad2deg,ethetai
3869 etheta=etheta+ethetai
3870 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3871 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3872 gloc(nphi+i-2,icg)=wang*dethetai
3878 c-----------------------------------------------------------------------------
3879 subroutine esc(escloc)
3880 C Calculate the local energy of a side chain and its derivatives in the
3881 C corresponding virtual-bond valence angles THETA and the spherical angles
3883 implicit real*8 (a-h,o-z)
3884 include 'DIMENSIONS'
3885 include 'DIMENSIONS.ZSCOPT'
3886 include 'COMMON.GEO'
3887 include 'COMMON.LOCAL'
3888 include 'COMMON.VAR'
3889 include 'COMMON.INTERACT'
3890 include 'COMMON.DERIV'
3891 include 'COMMON.CHAIN'
3892 include 'COMMON.IOUNITS'
3893 include 'COMMON.NAMES'
3894 include 'COMMON.FFIELD'
3895 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3896 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3897 common /sccalc/ time11,time12,time112,theti,it,nlobit
3900 C write (iout,*) 'ESC'
3901 do i=loc_start,loc_end
3903 if (it.eq.ntyp1) cycle
3904 if (it.eq.10) goto 1
3905 nlobit=nlob(iabs(it))
3906 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3907 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3908 theti=theta(i+1)-pipol
3912 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3914 if (x(2).gt.pi-delta) then
3918 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3920 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3921 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3923 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3924 & ddersc0(1),dersc(1))
3925 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3926 & ddersc0(3),dersc(3))
3928 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3930 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3931 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3932 & dersc0(2),esclocbi,dersc02)
3933 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3935 call splinthet(x(2),0.5d0*delta,ss,ssd)
3940 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3942 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3943 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3945 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3947 c write (iout,*) escloci
3948 else if (x(2).lt.delta) then
3952 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3954 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3955 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3957 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3958 & ddersc0(1),dersc(1))
3959 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3960 & ddersc0(3),dersc(3))
3962 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3964 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3965 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3966 & dersc0(2),esclocbi,dersc02)
3967 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3972 call splinthet(x(2),0.5d0*delta,ss,ssd)
3974 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3976 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3977 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3979 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3980 C write (iout,*) 'i=',i, escloci
3982 call enesc(x,escloci,dersc,ddummy,.false.)
3985 escloc=escloc+escloci
3986 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3987 write (iout,'(a6,i5,0pf7.3)')
3988 & 'escloc',i,escloci
3990 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3992 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3993 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3998 C---------------------------------------------------------------------------
3999 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4000 implicit real*8 (a-h,o-z)
4001 include 'DIMENSIONS'
4002 include 'COMMON.GEO'
4003 include 'COMMON.LOCAL'
4004 include 'COMMON.IOUNITS'
4005 common /sccalc/ time11,time12,time112,theti,it,nlobit
4006 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4007 double precision contr(maxlob,-1:1)
4009 c write (iout,*) 'it=',it,' nlobit=',nlobit
4013 if (mixed) ddersc(j)=0.0d0
4017 C Because of periodicity of the dependence of the SC energy in omega we have
4018 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4019 C To avoid underflows, first compute & store the exponents.
4027 z(k)=x(k)-censc(k,j,it)
4032 Axk=Axk+gaussc(l,k,j,it)*z(l)
4038 expfac=expfac+Ax(k,j,iii)*z(k)
4046 C As in the case of ebend, we want to avoid underflows in exponentiation and
4047 C subsequent NaNs and INFs in energy calculation.
4048 C Find the largest exponent
4052 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4056 cd print *,'it=',it,' emin=',emin
4058 C Compute the contribution to SC energy and derivatives
4062 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4063 cd print *,'j=',j,' expfac=',expfac
4064 escloc_i=escloc_i+expfac
4066 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4070 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4071 & +gaussc(k,2,j,it))*expfac
4078 dersc(1)=dersc(1)/cos(theti)**2
4079 ddersc(1)=ddersc(1)/cos(theti)**2
4082 escloci=-(dlog(escloc_i)-emin)
4084 dersc(j)=dersc(j)/escloc_i
4088 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4093 C------------------------------------------------------------------------------
4094 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4095 implicit real*8 (a-h,o-z)
4096 include 'DIMENSIONS'
4097 include 'COMMON.GEO'
4098 include 'COMMON.LOCAL'
4099 include 'COMMON.IOUNITS'
4100 common /sccalc/ time11,time12,time112,theti,it,nlobit
4101 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4102 double precision contr(maxlob)
4113 z(k)=x(k)-censc(k,j,it)
4119 Axk=Axk+gaussc(l,k,j,it)*z(l)
4125 expfac=expfac+Ax(k,j)*z(k)
4130 C As in the case of ebend, we want to avoid underflows in exponentiation and
4131 C subsequent NaNs and INFs in energy calculation.
4132 C Find the largest exponent
4135 if (emin.gt.contr(j)) emin=contr(j)
4139 C Compute the contribution to SC energy and derivatives
4143 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4144 escloc_i=escloc_i+expfac
4146 dersc(k)=dersc(k)+Ax(k,j)*expfac
4148 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4149 & +gaussc(1,2,j,it))*expfac
4153 dersc(1)=dersc(1)/cos(theti)**2
4154 dersc12=dersc12/cos(theti)**2
4155 escloci=-(dlog(escloc_i)-emin)
4157 dersc(j)=dersc(j)/escloc_i
4159 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4163 c----------------------------------------------------------------------------------
4164 subroutine esc(escloc)
4165 C Calculate the local energy of a side chain and its derivatives in the
4166 C corresponding virtual-bond valence angles THETA and the spherical angles
4167 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4168 C added by Urszula Kozlowska. 07/11/2007
4170 implicit real*8 (a-h,o-z)
4171 include 'DIMENSIONS'
4172 include 'DIMENSIONS.ZSCOPT'
4173 include 'COMMON.GEO'
4174 include 'COMMON.LOCAL'
4175 include 'COMMON.VAR'
4176 include 'COMMON.SCROT'
4177 include 'COMMON.INTERACT'
4178 include 'COMMON.DERIV'
4179 include 'COMMON.CHAIN'
4180 include 'COMMON.IOUNITS'
4181 include 'COMMON.NAMES'
4182 include 'COMMON.FFIELD'
4183 include 'COMMON.CONTROL'
4184 include 'COMMON.VECTORS'
4185 double precision x_prime(3),y_prime(3),z_prime(3)
4186 & , sumene,dsc_i,dp2_i,x(65),
4187 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4188 & de_dxx,de_dyy,de_dzz,de_dt
4189 double precision s1_t,s1_6_t,s2_t,s2_6_t
4191 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4192 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4193 & dt_dCi(3),dt_dCi1(3)
4194 common /sccalc/ time11,time12,time112,theti,it,nlobit
4197 do i=loc_start,loc_end
4198 if (itype(i).eq.ntyp1) cycle
4199 costtab(i+1) =dcos(theta(i+1))
4200 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4201 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4202 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4203 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4204 cosfac=dsqrt(cosfac2)
4205 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4206 sinfac=dsqrt(sinfac2)
4208 if (it.eq.10) goto 1
4210 C Compute the axes of tghe local cartesian coordinates system; store in
4211 c x_prime, y_prime and z_prime
4218 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4219 C & dc_norm(3,i+nres)
4221 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4222 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4225 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4228 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4229 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4230 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4231 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4232 c & " xy",scalar(x_prime(1),y_prime(1)),
4233 c & " xz",scalar(x_prime(1),z_prime(1)),
4234 c & " yy",scalar(y_prime(1),y_prime(1)),
4235 c & " yz",scalar(y_prime(1),z_prime(1)),
4236 c & " zz",scalar(z_prime(1),z_prime(1))
4238 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4239 C to local coordinate system. Store in xx, yy, zz.
4245 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4246 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4247 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4254 C Compute the energy of the ith side cbain
4256 c write (2,*) "xx",xx," yy",yy," zz",zz
4259 x(j) = sc_parmin(j,it)
4262 Cc diagnostics - remove later
4264 yy1 = dsin(alph(2))*dcos(omeg(2))
4265 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4266 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4267 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4269 C," --- ", xx_w,yy_w,zz_w
4272 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4273 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4275 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4276 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4278 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4279 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4280 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4281 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4282 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4284 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4285 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4286 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4287 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4288 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4290 dsc_i = 0.743d0+x(61)
4292 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4293 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4294 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4295 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4296 s1=(1+x(63))/(0.1d0 + dscp1)
4297 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4298 s2=(1+x(65))/(0.1d0 + dscp2)
4299 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4300 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4301 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4302 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4304 c & dscp1,dscp2,sumene
4305 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4306 escloc = escloc + sumene
4307 c write (2,*) "escloc",escloc
4308 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4310 if (.not. calc_grad) goto 1
4313 C This section to check the numerical derivatives of the energy of ith side
4314 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4315 C #define DEBUG in the code to turn it on.
4317 write (2,*) "sumene =",sumene
4321 write (2,*) xx,yy,zz
4322 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4323 de_dxx_num=(sumenep-sumene)/aincr
4325 write (2,*) "xx+ sumene from enesc=",sumenep
4328 write (2,*) xx,yy,zz
4329 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4330 de_dyy_num=(sumenep-sumene)/aincr
4332 write (2,*) "yy+ sumene from enesc=",sumenep
4335 write (2,*) xx,yy,zz
4336 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4337 de_dzz_num=(sumenep-sumene)/aincr
4339 write (2,*) "zz+ sumene from enesc=",sumenep
4340 costsave=cost2tab(i+1)
4341 sintsave=sint2tab(i+1)
4342 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4343 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4344 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4345 de_dt_num=(sumenep-sumene)/aincr
4346 write (2,*) " t+ sumene from enesc=",sumenep
4347 cost2tab(i+1)=costsave
4348 sint2tab(i+1)=sintsave
4349 C End of diagnostics section.
4352 C Compute the gradient of esc
4354 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4355 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4356 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4357 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4358 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4359 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4360 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4361 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4362 pom1=(sumene3*sint2tab(i+1)+sumene1)
4363 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4364 pom2=(sumene4*cost2tab(i+1)+sumene2)
4365 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4366 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4367 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4368 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4370 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4371 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4372 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4374 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4375 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4376 & +(pom1+pom2)*pom_dx
4378 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4381 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4382 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4383 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4385 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4386 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4387 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4388 & +x(59)*zz**2 +x(60)*xx*zz
4389 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4390 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4391 & +(pom1-pom2)*pom_dy
4393 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4396 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4397 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4398 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4399 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4400 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4401 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4402 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4403 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4405 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4408 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4409 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4410 & +pom1*pom_dt1+pom2*pom_dt2
4412 write(2,*), "de_dt = ", de_dt,de_dt_num
4416 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4417 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4418 cosfac2xx=cosfac2*xx
4419 sinfac2yy=sinfac2*yy
4421 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4423 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4425 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4426 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4427 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4428 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4429 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4430 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4431 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4432 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4433 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4434 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4438 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4439 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4440 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4441 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4444 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4445 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4446 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4448 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4449 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4453 dXX_Ctab(k,i)=dXX_Ci(k)
4454 dXX_C1tab(k,i)=dXX_Ci1(k)
4455 dYY_Ctab(k,i)=dYY_Ci(k)
4456 dYY_C1tab(k,i)=dYY_Ci1(k)
4457 dZZ_Ctab(k,i)=dZZ_Ci(k)
4458 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4459 dXX_XYZtab(k,i)=dXX_XYZ(k)
4460 dYY_XYZtab(k,i)=dYY_XYZ(k)
4461 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4465 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4466 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4467 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4468 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4469 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4471 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4472 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4473 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4474 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4475 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4476 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4477 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4478 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4480 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4481 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4483 C to check gradient call subroutine check_grad
4490 c------------------------------------------------------------------------------
4491 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4493 C This procedure calculates two-body contact function g(rij) and its derivative:
4496 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4499 C where x=(rij-r0ij)/delta
4501 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4504 double precision rij,r0ij,eps0ij,fcont,fprimcont
4505 double precision x,x2,x4,delta
4509 if (x.lt.-1.0D0) then
4512 else if (x.le.1.0D0) then
4515 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4516 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4523 c------------------------------------------------------------------------------
4524 subroutine splinthet(theti,delta,ss,ssder)
4525 implicit real*8 (a-h,o-z)
4526 include 'DIMENSIONS'
4527 include 'DIMENSIONS.ZSCOPT'
4528 include 'COMMON.VAR'
4529 include 'COMMON.GEO'
4532 if (theti.gt.pipol) then
4533 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4535 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4540 c------------------------------------------------------------------------------
4541 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4543 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4544 double precision ksi,ksi2,ksi3,a1,a2,a3
4545 a1=fprim0*delta/(f1-f0)
4551 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4552 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4555 c------------------------------------------------------------------------------
4556 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4558 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4559 double precision ksi,ksi2,ksi3,a1,a2,a3
4564 a2=3*(f1x-f0x)-2*fprim0x*delta
4565 a3=fprim0x*delta-2*(f1x-f0x)
4566 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4569 C-----------------------------------------------------------------------------
4571 C-----------------------------------------------------------------------------
4572 subroutine etor(etors,edihcnstr,fact)
4573 implicit real*8 (a-h,o-z)
4574 include 'DIMENSIONS'
4575 include 'DIMENSIONS.ZSCOPT'
4576 include 'COMMON.VAR'
4577 include 'COMMON.GEO'
4578 include 'COMMON.LOCAL'
4579 include 'COMMON.TORSION'
4580 include 'COMMON.INTERACT'
4581 include 'COMMON.DERIV'
4582 include 'COMMON.CHAIN'
4583 include 'COMMON.NAMES'
4584 include 'COMMON.IOUNITS'
4585 include 'COMMON.FFIELD'
4586 include 'COMMON.TORCNSTR'
4588 C Set lprn=.true. for debugging
4592 do i=iphi_start,iphi_end
4593 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4594 & .or. itype(i).eq.ntyp1) cycle
4595 itori=itortyp(itype(i-2))
4596 itori1=itortyp(itype(i-1))
4599 C Proline-Proline pair is a special case...
4600 if (itori.eq.3 .and. itori1.eq.3) then
4601 if (phii.gt.-dwapi3) then
4603 fac=1.0D0/(1.0D0-cosphi)
4604 etorsi=v1(1,3,3)*fac
4605 etorsi=etorsi+etorsi
4606 etors=etors+etorsi-v1(1,3,3)
4607 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4610 v1ij=v1(j+1,itori,itori1)
4611 v2ij=v2(j+1,itori,itori1)
4614 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4615 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4619 v1ij=v1(j,itori,itori1)
4620 v2ij=v2(j,itori,itori1)
4623 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4624 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4628 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4629 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4630 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4631 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4632 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4634 ! 6/20/98 - dihedral angle constraints
4637 itori=idih_constr(i)
4640 if (difi.gt.drange(i)) then
4642 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4643 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4644 else if (difi.lt.-drange(i)) then
4646 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4647 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4649 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4650 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4652 ! write (iout,*) 'edihcnstr',edihcnstr
4655 c------------------------------------------------------------------------------
4657 subroutine etor(etors,edihcnstr,fact)
4658 implicit real*8 (a-h,o-z)
4659 include 'DIMENSIONS'
4660 include 'DIMENSIONS.ZSCOPT'
4661 include 'COMMON.VAR'
4662 include 'COMMON.GEO'
4663 include 'COMMON.LOCAL'
4664 include 'COMMON.TORSION'
4665 include 'COMMON.INTERACT'
4666 include 'COMMON.DERIV'
4667 include 'COMMON.CHAIN'
4668 include 'COMMON.NAMES'
4669 include 'COMMON.IOUNITS'
4670 include 'COMMON.FFIELD'
4671 include 'COMMON.TORCNSTR'
4673 C Set lprn=.true. for debugging
4677 do i=iphi_start,iphi_end
4679 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4680 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4681 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4682 C & .or. itype(i).eq.ntyp1) cycle
4683 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4684 if (iabs(itype(i)).eq.20) then
4689 itori=itortyp(itype(i-2))
4690 itori1=itortyp(itype(i-1))
4693 C Regular cosine and sine terms
4694 do j=1,nterm(itori,itori1,iblock)
4695 v1ij=v1(j,itori,itori1,iblock)
4696 v2ij=v2(j,itori,itori1,iblock)
4699 etors=etors+v1ij*cosphi+v2ij*sinphi
4700 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4704 C E = SUM ----------------------------------- - v1
4705 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4707 cosphi=dcos(0.5d0*phii)
4708 sinphi=dsin(0.5d0*phii)
4709 do j=1,nlor(itori,itori1,iblock)
4710 vl1ij=vlor1(j,itori,itori1)
4711 vl2ij=vlor2(j,itori,itori1)
4712 vl3ij=vlor3(j,itori,itori1)
4713 pom=vl2ij*cosphi+vl3ij*sinphi
4714 pom1=1.0d0/(pom*pom+1.0d0)
4715 etors=etors+vl1ij*pom1
4716 c if (energy_dec) etors_ii=etors_ii+
4719 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4721 C Subtract the constant term
4722 etors=etors-v0(itori,itori1,iblock)
4724 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4725 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4726 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4727 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4728 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4731 ! 6/20/98 - dihedral angle constraints
4734 itori=idih_constr(i)
4736 difi=pinorm(phii-phi0(i))
4738 if (difi.gt.drange(i)) then
4740 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4741 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4742 edihi=0.25d0*ftors*difi**4
4743 else if (difi.lt.-drange(i)) then
4745 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4746 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4747 edihi=0.25d0*ftors*difi**4
4751 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4753 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4754 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4756 ! write (iout,*) 'edihcnstr',edihcnstr
4759 c----------------------------------------------------------------------------
4760 subroutine etor_d(etors_d,fact2)
4761 C 6/23/01 Compute double torsional energy
4762 implicit real*8 (a-h,o-z)
4763 include 'DIMENSIONS'
4764 include 'DIMENSIONS.ZSCOPT'
4765 include 'COMMON.VAR'
4766 include 'COMMON.GEO'
4767 include 'COMMON.LOCAL'
4768 include 'COMMON.TORSION'
4769 include 'COMMON.INTERACT'
4770 include 'COMMON.DERIV'
4771 include 'COMMON.CHAIN'
4772 include 'COMMON.NAMES'
4773 include 'COMMON.IOUNITS'
4774 include 'COMMON.FFIELD'
4775 include 'COMMON.TORCNSTR'
4777 C Set lprn=.true. for debugging
4781 do i=iphi_start,iphi_end-1
4783 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4784 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4785 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4786 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4787 & (itype(i+1).eq.ntyp1)) cycle
4788 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4790 itori=itortyp(itype(i-2))
4791 itori1=itortyp(itype(i-1))
4792 itori2=itortyp(itype(i))
4798 if (iabs(itype(i+1)).eq.20) iblock=2
4799 C Regular cosine and sine terms
4800 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4801 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4802 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4803 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4804 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4805 cosphi1=dcos(j*phii)
4806 sinphi1=dsin(j*phii)
4807 cosphi2=dcos(j*phii1)
4808 sinphi2=dsin(j*phii1)
4809 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4810 & v2cij*cosphi2+v2sij*sinphi2
4811 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4812 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4814 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4816 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4817 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4818 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4819 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4820 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4821 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4822 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4823 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4824 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4825 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4826 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4827 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4828 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4829 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4832 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4833 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4839 c------------------------------------------------------------------------------
4840 subroutine eback_sc_corr(esccor)
4841 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4842 c conformational states; temporarily implemented as differences
4843 c between UNRES torsional potentials (dependent on three types of
4844 c residues) and the torsional potentials dependent on all 20 types
4845 c of residues computed from AM1 energy surfaces of terminally-blocked
4846 c amino-acid residues.
4847 implicit real*8 (a-h,o-z)
4848 include 'DIMENSIONS'
4849 include 'DIMENSIONS.ZSCOPT'
4850 include 'COMMON.VAR'
4851 include 'COMMON.GEO'
4852 include 'COMMON.LOCAL'
4853 include 'COMMON.TORSION'
4854 include 'COMMON.SCCOR'
4855 include 'COMMON.INTERACT'
4856 include 'COMMON.DERIV'
4857 include 'COMMON.CHAIN'
4858 include 'COMMON.NAMES'
4859 include 'COMMON.IOUNITS'
4860 include 'COMMON.FFIELD'
4861 include 'COMMON.CONTROL'
4863 C Set lprn=.true. for debugging
4866 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4868 do i=itau_start,itau_end
4869 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4871 isccori=isccortyp(itype(i-2))
4872 isccori1=isccortyp(itype(i-1))
4874 do intertyp=1,3 !intertyp
4875 cc Added 09 May 2012 (Adasko)
4876 cc Intertyp means interaction type of backbone mainchain correlation:
4877 c 1 = SC...Ca...Ca...Ca
4878 c 2 = Ca...Ca...Ca...SC
4879 c 3 = SC...Ca...Ca...SCi
4881 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4882 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4883 & (itype(i-1).eq.ntyp1)))
4884 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4885 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4886 & .or.(itype(i).eq.ntyp1)))
4887 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4888 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4889 & (itype(i-3).eq.ntyp1)))) cycle
4890 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4891 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4893 do j=1,nterm_sccor(isccori,isccori1)
4894 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4895 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4896 cosphi=dcos(j*tauangle(intertyp,i))
4897 sinphi=dsin(j*tauangle(intertyp,i))
4898 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4899 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4901 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4902 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4903 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4905 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4906 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4907 & (v1sccor(j,1,itori,itori1),j=1,6)
4908 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4909 c gsccor_loc(i-3)=gloci
4914 c------------------------------------------------------------------------------
4915 subroutine multibody(ecorr)
4916 C This subroutine calculates multi-body contributions to energy following
4917 C the idea of Skolnick et al. If side chains I and J make a contact and
4918 C at the same time side chains I+1 and J+1 make a contact, an extra
4919 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4920 implicit real*8 (a-h,o-z)
4921 include 'DIMENSIONS'
4922 include 'COMMON.IOUNITS'
4923 include 'COMMON.DERIV'
4924 include 'COMMON.INTERACT'
4925 include 'COMMON.CONTACTS'
4926 double precision gx(3),gx1(3)
4929 C Set lprn=.true. for debugging
4933 write (iout,'(a)') 'Contact function values:'
4935 write (iout,'(i2,20(1x,i2,f10.5))')
4936 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4951 num_conti=num_cont(i)
4952 num_conti1=num_cont(i1)
4957 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4958 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4959 cd & ' ishift=',ishift
4960 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4961 C The system gains extra energy.
4962 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4963 endif ! j1==j+-ishift
4972 c------------------------------------------------------------------------------
4973 double precision function esccorr(i,j,k,l,jj,kk)
4974 implicit real*8 (a-h,o-z)
4975 include 'DIMENSIONS'
4976 include 'COMMON.IOUNITS'
4977 include 'COMMON.DERIV'
4978 include 'COMMON.INTERACT'
4979 include 'COMMON.CONTACTS'
4980 double precision gx(3),gx1(3)
4985 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4986 C Calculate the multi-body contribution to energy.
4987 C Calculate multi-body contributions to the gradient.
4988 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4989 cd & k,l,(gacont(m,kk,k),m=1,3)
4991 gx(m) =ekl*gacont(m,jj,i)
4992 gx1(m)=eij*gacont(m,kk,k)
4993 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4994 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4995 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4996 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5000 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5005 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5011 c------------------------------------------------------------------------------
5013 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5014 implicit real*8 (a-h,o-z)
5015 include 'DIMENSIONS'
5016 integer dimen1,dimen2,atom,indx
5017 double precision buffer(dimen1,dimen2)
5018 double precision zapas
5019 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5020 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5021 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5022 num_kont=num_cont_hb(atom)
5026 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5029 buffer(i,indx+22)=facont_hb(i,atom)
5030 buffer(i,indx+23)=ees0p(i,atom)
5031 buffer(i,indx+24)=ees0m(i,atom)
5032 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5034 buffer(1,indx+26)=dfloat(num_kont)
5037 c------------------------------------------------------------------------------
5038 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5039 implicit real*8 (a-h,o-z)
5040 include 'DIMENSIONS'
5041 integer dimen1,dimen2,atom,indx
5042 double precision buffer(dimen1,dimen2)
5043 double precision zapas
5044 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5045 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5046 & ees0m(ntyp,maxres),
5047 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5048 num_kont=buffer(1,indx+26)
5049 num_kont_old=num_cont_hb(atom)
5050 num_cont_hb(atom)=num_kont+num_kont_old
5055 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5058 facont_hb(ii,atom)=buffer(i,indx+22)
5059 ees0p(ii,atom)=buffer(i,indx+23)
5060 ees0m(ii,atom)=buffer(i,indx+24)
5061 jcont_hb(ii,atom)=buffer(i,indx+25)
5065 c------------------------------------------------------------------------------
5067 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5068 C This subroutine calculates multi-body contributions to hydrogen-bonding
5069 implicit real*8 (a-h,o-z)
5070 include 'DIMENSIONS'
5071 include 'DIMENSIONS.ZSCOPT'
5072 include 'COMMON.IOUNITS'
5074 include 'COMMON.INFO'
5076 include 'COMMON.FFIELD'
5077 include 'COMMON.DERIV'
5078 include 'COMMON.INTERACT'
5079 include 'COMMON.CONTACTS'
5081 parameter (max_cont=maxconts)
5082 parameter (max_dim=2*(8*3+2))
5083 parameter (msglen1=max_cont*max_dim*4)
5084 parameter (msglen2=2*msglen1)
5085 integer source,CorrelType,CorrelID,Error
5086 double precision buffer(max_cont,max_dim)
5088 double precision gx(3),gx1(3)
5091 C Set lprn=.true. for debugging
5096 if (fgProcs.le.1) goto 30
5098 write (iout,'(a)') 'Contact function values:'
5100 write (iout,'(2i3,50(1x,i2,f5.2))')
5101 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5102 & j=1,num_cont_hb(i))
5105 C Caution! Following code assumes that electrostatic interactions concerning
5106 C a given atom are split among at most two processors!
5116 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5119 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5120 if (MyRank.gt.0) then
5121 C Send correlation contributions to the preceding processor
5123 nn=num_cont_hb(iatel_s)
5124 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5125 cd write (iout,*) 'The BUFFER array:'
5127 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5129 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5131 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5132 C Clear the contacts of the atom passed to the neighboring processor
5133 nn=num_cont_hb(iatel_s+1)
5135 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5137 num_cont_hb(iatel_s)=0
5139 cd write (iout,*) 'Processor ',MyID,MyRank,
5140 cd & ' is sending correlation contribution to processor',MyID-1,
5141 cd & ' msglen=',msglen
5142 cd write (*,*) 'Processor ',MyID,MyRank,
5143 cd & ' is sending correlation contribution to processor',MyID-1,
5144 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5145 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5146 cd write (iout,*) 'Processor ',MyID,
5147 cd & ' has sent correlation contribution to processor',MyID-1,
5148 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5149 cd write (*,*) 'Processor ',MyID,
5150 cd & ' has sent correlation contribution to processor',MyID-1,
5151 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5153 endif ! (MyRank.gt.0)
5157 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5158 if (MyRank.lt.fgProcs-1) then
5159 C Receive correlation contributions from the next processor
5161 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5162 cd write (iout,*) 'Processor',MyID,
5163 cd & ' is receiving correlation contribution from processor',MyID+1,
5164 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5165 cd write (*,*) 'Processor',MyID,
5166 cd & ' is receiving correlation contribution from processor',MyID+1,
5167 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5169 do while (nbytes.le.0)
5170 call mp_probe(MyID+1,CorrelType,nbytes)
5172 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5173 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5174 cd write (iout,*) 'Processor',MyID,
5175 cd & ' has received correlation contribution from processor',MyID+1,
5176 cd & ' msglen=',msglen,' nbytes=',nbytes
5177 cd write (iout,*) 'The received BUFFER array:'
5179 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5181 if (msglen.eq.msglen1) then
5182 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5183 else if (msglen.eq.msglen2) then
5184 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5185 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5188 & 'ERROR!!!! message length changed while processing correlations.'
5190 & 'ERROR!!!! message length changed while processing correlations.'
5191 call mp_stopall(Error)
5192 endif ! msglen.eq.msglen1
5193 endif ! MyRank.lt.fgProcs-1
5200 write (iout,'(a)') 'Contact function values:'
5202 write (iout,'(2i3,50(1x,i2,f5.2))')
5203 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5204 & j=1,num_cont_hb(i))
5208 C Remove the loop below after debugging !!!
5215 C Calculate the local-electrostatic correlation terms
5216 do i=iatel_s,iatel_e+1
5218 num_conti=num_cont_hb(i)
5219 num_conti1=num_cont_hb(i+1)
5224 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5225 c & ' jj=',jj,' kk=',kk
5226 if (j1.eq.j+1 .or. j1.eq.j-1) then
5227 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5228 C The system gains extra energy.
5229 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5231 else if (j1.eq.j) then
5232 C Contacts I-J and I-(J+1) occur simultaneously.
5233 C The system loses extra energy.
5234 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5239 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5240 c & ' jj=',jj,' kk=',kk
5242 C Contacts I-J and (I+1)-J occur simultaneously.
5243 C The system loses extra energy.
5244 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5251 c------------------------------------------------------------------------------
5252 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5254 C This subroutine calculates multi-body contributions to hydrogen-bonding
5255 implicit real*8 (a-h,o-z)
5256 include 'DIMENSIONS'
5257 include 'DIMENSIONS.ZSCOPT'
5258 include 'COMMON.IOUNITS'
5260 include 'COMMON.INFO'
5262 include 'COMMON.FFIELD'
5263 include 'COMMON.DERIV'
5264 include 'COMMON.INTERACT'
5265 include 'COMMON.CONTACTS'
5267 parameter (max_cont=maxconts)
5268 parameter (max_dim=2*(8*3+2))
5269 parameter (msglen1=max_cont*max_dim*4)
5270 parameter (msglen2=2*msglen1)
5271 integer source,CorrelType,CorrelID,Error
5272 double precision buffer(max_cont,max_dim)
5274 double precision gx(3),gx1(3)
5277 C Set lprn=.true. for debugging
5283 if (fgProcs.le.1) goto 30
5285 write (iout,'(a)') 'Contact function values:'
5287 write (iout,'(2i3,50(1x,i2,f5.2))')
5288 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5289 & j=1,num_cont_hb(i))
5292 C Caution! Following code assumes that electrostatic interactions concerning
5293 C a given atom are split among at most two processors!
5303 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5306 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5307 if (MyRank.gt.0) then
5308 C Send correlation contributions to the preceding processor
5310 nn=num_cont_hb(iatel_s)
5311 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5312 cd write (iout,*) 'The BUFFER array:'
5314 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5316 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5318 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5319 C Clear the contacts of the atom passed to the neighboring processor
5320 nn=num_cont_hb(iatel_s+1)
5322 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5324 num_cont_hb(iatel_s)=0
5326 cd write (iout,*) 'Processor ',MyID,MyRank,
5327 cd & ' is sending correlation contribution to processor',MyID-1,
5328 cd & ' msglen=',msglen
5329 cd write (*,*) 'Processor ',MyID,MyRank,
5330 cd & ' is sending correlation contribution to processor',MyID-1,
5331 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5332 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5333 cd write (iout,*) 'Processor ',MyID,
5334 cd & ' has sent correlation contribution to processor',MyID-1,
5335 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5336 cd write (*,*) 'Processor ',MyID,
5337 cd & ' has sent correlation contribution to processor',MyID-1,
5338 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5340 endif ! (MyRank.gt.0)
5344 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5345 if (MyRank.lt.fgProcs-1) then
5346 C Receive correlation contributions from the next processor
5348 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5349 cd write (iout,*) 'Processor',MyID,
5350 cd & ' is receiving correlation contribution from processor',MyID+1,
5351 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5352 cd write (*,*) 'Processor',MyID,
5353 cd & ' is receiving correlation contribution from processor',MyID+1,
5354 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5356 do while (nbytes.le.0)
5357 call mp_probe(MyID+1,CorrelType,nbytes)
5359 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5360 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5361 cd write (iout,*) 'Processor',MyID,
5362 cd & ' has received correlation contribution from processor',MyID+1,
5363 cd & ' msglen=',msglen,' nbytes=',nbytes
5364 cd write (iout,*) 'The received BUFFER array:'
5366 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5368 if (msglen.eq.msglen1) then
5369 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5370 else if (msglen.eq.msglen2) then
5371 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5372 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5375 & 'ERROR!!!! message length changed while processing correlations.'
5377 & 'ERROR!!!! message length changed while processing correlations.'
5378 call mp_stopall(Error)
5379 endif ! msglen.eq.msglen1
5380 endif ! MyRank.lt.fgProcs-1
5387 write (iout,'(a)') 'Contact function values:'
5389 write (iout,'(2i3,50(1x,i2,f5.2))')
5390 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5391 & j=1,num_cont_hb(i))
5397 C Remove the loop below after debugging !!!
5404 C Calculate the dipole-dipole interaction energies
5405 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5406 do i=iatel_s,iatel_e+1
5407 num_conti=num_cont_hb(i)
5414 C Calculate the local-electrostatic correlation terms
5415 do i=iatel_s,iatel_e+1
5417 num_conti=num_cont_hb(i)
5418 num_conti1=num_cont_hb(i+1)
5423 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5424 c & ' jj=',jj,' kk=',kk
5425 if (j1.eq.j+1 .or. j1.eq.j-1) then
5426 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5427 C The system gains extra energy.
5429 sqd1=dsqrt(d_cont(jj,i))
5430 sqd2=dsqrt(d_cont(kk,i1))
5431 sred_geom = sqd1*sqd2
5432 IF (sred_geom.lt.cutoff_corr) THEN
5433 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5435 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5436 c & ' jj=',jj,' kk=',kk
5437 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5438 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5440 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5441 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5444 cd write (iout,*) 'sred_geom=',sred_geom,
5445 cd & ' ekont=',ekont,' fprim=',fprimcont
5446 call calc_eello(i,j,i+1,j1,jj,kk)
5447 if (wcorr4.gt.0.0d0)
5448 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5449 if (wcorr5.gt.0.0d0)
5450 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5451 c print *,"wcorr5",ecorr5
5452 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5453 cd write(2,*)'ijkl',i,j,i+1,j1
5454 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5455 & .or. wturn6.eq.0.0d0))then
5456 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5457 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5458 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5459 cd & 'ecorr6=',ecorr6
5460 cd write (iout,'(4e15.5)') sred_geom,
5461 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5462 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5463 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5464 else if (wturn6.gt.0.0d0
5465 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5466 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5467 eturn6=eturn6+eello_turn6(i,jj,kk)
5468 cd write (2,*) 'multibody_eello:eturn6',eturn6
5472 else if (j1.eq.j) then
5473 C Contacts I-J and I-(J+1) occur simultaneously.
5474 C The system loses extra energy.
5475 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5480 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5481 c & ' jj=',jj,' kk=',kk
5483 C Contacts I-J and (I+1)-J occur simultaneously.
5484 C The system loses extra energy.
5485 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5492 c------------------------------------------------------------------------------
5493 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5494 implicit real*8 (a-h,o-z)
5495 include 'DIMENSIONS'
5496 include 'COMMON.IOUNITS'
5497 include 'COMMON.DERIV'
5498 include 'COMMON.INTERACT'
5499 include 'COMMON.CONTACTS'
5500 double precision gx(3),gx1(3)
5510 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5511 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5512 C Following 4 lines for diagnostics.
5517 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5519 c write (iout,*)'Contacts have occurred for peptide groups',
5520 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5521 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5522 C Calculate the multi-body contribution to energy.
5523 ecorr=ecorr+ekont*ees
5525 C Calculate multi-body contributions to the gradient.
5527 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5528 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5529 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5530 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5531 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5532 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5533 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5534 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5535 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5536 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5537 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5538 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5539 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5540 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5544 gradcorr(ll,m)=gradcorr(ll,m)+
5545 & ees*ekl*gacont_hbr(ll,jj,i)-
5546 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5547 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5552 gradcorr(ll,m)=gradcorr(ll,m)+
5553 & ees*eij*gacont_hbr(ll,kk,k)-
5554 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5555 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5562 C---------------------------------------------------------------------------
5563 subroutine dipole(i,j,jj)
5564 implicit real*8 (a-h,o-z)
5565 include 'DIMENSIONS'
5566 include 'DIMENSIONS.ZSCOPT'
5567 include 'COMMON.IOUNITS'
5568 include 'COMMON.CHAIN'
5569 include 'COMMON.FFIELD'
5570 include 'COMMON.DERIV'
5571 include 'COMMON.INTERACT'
5572 include 'COMMON.CONTACTS'
5573 include 'COMMON.TORSION'
5574 include 'COMMON.VAR'
5575 include 'COMMON.GEO'
5576 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5578 iti1 = itortyp(itype(i+1))
5579 if (j.lt.nres-1) then
5580 if (itype(j).le.ntyp) then
5581 itj1 = itortyp(itype(j+1))
5589 dipi(iii,1)=Ub2(iii,i)
5590 dipderi(iii)=Ub2der(iii,i)
5591 dipi(iii,2)=b1(iii,iti1)
5592 dipj(iii,1)=Ub2(iii,j)
5593 dipderj(iii)=Ub2der(iii,j)
5594 dipj(iii,2)=b1(iii,itj1)
5598 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5601 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5604 if (.not.calc_grad) return
5609 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5613 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5618 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5619 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5621 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5623 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5625 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5629 C---------------------------------------------------------------------------
5630 subroutine calc_eello(i,j,k,l,jj,kk)
5632 C This subroutine computes matrices and vectors needed to calculate
5633 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5635 implicit real*8 (a-h,o-z)
5636 include 'DIMENSIONS'
5637 include 'DIMENSIONS.ZSCOPT'
5638 include 'COMMON.IOUNITS'
5639 include 'COMMON.CHAIN'
5640 include 'COMMON.DERIV'
5641 include 'COMMON.INTERACT'
5642 include 'COMMON.CONTACTS'
5643 include 'COMMON.TORSION'
5644 include 'COMMON.VAR'
5645 include 'COMMON.GEO'
5646 include 'COMMON.FFIELD'
5647 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5648 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5651 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5652 cd & ' jj=',jj,' kk=',kk
5653 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5656 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5657 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5660 call transpose2(aa1(1,1),aa1t(1,1))
5661 call transpose2(aa2(1,1),aa2t(1,1))
5664 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5665 & aa1tder(1,1,lll,kkk))
5666 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5667 & aa2tder(1,1,lll,kkk))
5671 C parallel orientation of the two CA-CA-CA frames.
5672 if (i.gt.1 .and. itype(i).le.ntyp) then
5673 iti=itortyp(itype(i))
5677 itk1=itortyp(itype(k+1))
5678 itj=itortyp(itype(j))
5679 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5680 itl1=itortyp(itype(l+1))
5684 C A1 kernel(j+1) A2T
5686 cd write (iout,'(3f10.5,5x,3f10.5)')
5687 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5689 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5690 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5691 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5692 C Following matrices are needed only for 6-th order cumulants
5693 IF (wcorr6.gt.0.0d0) THEN
5694 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5695 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5696 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5697 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5698 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5699 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5700 & ADtEAderx(1,1,1,1,1,1))
5702 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5703 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5704 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5705 & ADtEA1derx(1,1,1,1,1,1))
5707 C End 6-th order cumulants
5710 cd write (2,*) 'In calc_eello6'
5712 cd write (2,*) 'iii=',iii
5714 cd write (2,*) 'kkk=',kkk
5716 cd write (2,'(3(2f10.5),5x)')
5717 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5722 call transpose2(EUgder(1,1,k),auxmat(1,1))
5723 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5724 call transpose2(EUg(1,1,k),auxmat(1,1))
5725 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5726 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5730 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5731 & EAEAderx(1,1,lll,kkk,iii,1))
5735 C A1T kernel(i+1) A2
5736 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5737 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5738 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5739 C Following matrices are needed only for 6-th order cumulants
5740 IF (wcorr6.gt.0.0d0) THEN
5741 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5742 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5743 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5744 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5745 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5746 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5747 & ADtEAderx(1,1,1,1,1,2))
5748 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5749 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5750 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5751 & ADtEA1derx(1,1,1,1,1,2))
5753 C End 6-th order cumulants
5754 call transpose2(EUgder(1,1,l),auxmat(1,1))
5755 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5756 call transpose2(EUg(1,1,l),auxmat(1,1))
5757 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5758 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5762 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5763 & EAEAderx(1,1,lll,kkk,iii,2))
5768 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5769 C They are needed only when the fifth- or the sixth-order cumulants are
5771 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5772 call transpose2(AEA(1,1,1),auxmat(1,1))
5773 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5774 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5775 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5776 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5777 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5778 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5779 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5780 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5781 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5782 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5783 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5784 call transpose2(AEA(1,1,2),auxmat(1,1))
5785 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5786 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5787 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5788 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5789 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5790 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5791 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5792 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5793 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5794 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5795 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5796 C Calculate the Cartesian derivatives of the vectors.
5800 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5801 call matvec2(auxmat(1,1),b1(1,iti),
5802 & AEAb1derx(1,lll,kkk,iii,1,1))
5803 call matvec2(auxmat(1,1),Ub2(1,i),
5804 & AEAb2derx(1,lll,kkk,iii,1,1))
5805 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5806 & AEAb1derx(1,lll,kkk,iii,2,1))
5807 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5808 & AEAb2derx(1,lll,kkk,iii,2,1))
5809 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5810 call matvec2(auxmat(1,1),b1(1,itj),
5811 & AEAb1derx(1,lll,kkk,iii,1,2))
5812 call matvec2(auxmat(1,1),Ub2(1,j),
5813 & AEAb2derx(1,lll,kkk,iii,1,2))
5814 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5815 & AEAb1derx(1,lll,kkk,iii,2,2))
5816 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5817 & AEAb2derx(1,lll,kkk,iii,2,2))
5824 C Antiparallel orientation of the two CA-CA-CA frames.
5825 if (i.gt.1 .and. itype(i).le.ntyp) then
5826 iti=itortyp(itype(i))
5830 itk1=itortyp(itype(k+1))
5831 itl=itortyp(itype(l))
5832 itj=itortyp(itype(j))
5833 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5834 itj1=itortyp(itype(j+1))
5838 C A2 kernel(j-1)T A1T
5839 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5840 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5841 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5842 C Following matrices are needed only for 6-th order cumulants
5843 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5844 & j.eq.i+4 .and. l.eq.i+3)) THEN
5845 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5846 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5847 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5848 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5849 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5850 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5851 & ADtEAderx(1,1,1,1,1,1))
5852 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5853 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5854 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5855 & ADtEA1derx(1,1,1,1,1,1))
5857 C End 6-th order cumulants
5858 call transpose2(EUgder(1,1,k),auxmat(1,1))
5859 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5860 call transpose2(EUg(1,1,k),auxmat(1,1))
5861 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5862 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5866 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5867 & EAEAderx(1,1,lll,kkk,iii,1))
5871 C A2T kernel(i+1)T A1
5872 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5873 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5874 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5875 C Following matrices are needed only for 6-th order cumulants
5876 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5877 & j.eq.i+4 .and. l.eq.i+3)) THEN
5878 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5879 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5880 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5881 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5882 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5883 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5884 & ADtEAderx(1,1,1,1,1,2))
5885 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5886 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5887 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5888 & ADtEA1derx(1,1,1,1,1,2))
5890 C End 6-th order cumulants
5891 call transpose2(EUgder(1,1,j),auxmat(1,1))
5892 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5893 call transpose2(EUg(1,1,j),auxmat(1,1))
5894 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5895 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5899 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5900 & EAEAderx(1,1,lll,kkk,iii,2))
5905 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5906 C They are needed only when the fifth- or the sixth-order cumulants are
5908 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5909 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5910 call transpose2(AEA(1,1,1),auxmat(1,1))
5911 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5912 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5913 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5914 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5915 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5916 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5917 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5918 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5919 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5920 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5921 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5922 call transpose2(AEA(1,1,2),auxmat(1,1))
5923 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5924 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5925 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5926 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5927 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5928 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5929 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5930 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5931 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5932 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5933 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5934 C Calculate the Cartesian derivatives of the vectors.
5938 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5939 call matvec2(auxmat(1,1),b1(1,iti),
5940 & AEAb1derx(1,lll,kkk,iii,1,1))
5941 call matvec2(auxmat(1,1),Ub2(1,i),
5942 & AEAb2derx(1,lll,kkk,iii,1,1))
5943 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5944 & AEAb1derx(1,lll,kkk,iii,2,1))
5945 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5946 & AEAb2derx(1,lll,kkk,iii,2,1))
5947 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5948 call matvec2(auxmat(1,1),b1(1,itl),
5949 & AEAb1derx(1,lll,kkk,iii,1,2))
5950 call matvec2(auxmat(1,1),Ub2(1,l),
5951 & AEAb2derx(1,lll,kkk,iii,1,2))
5952 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5953 & AEAb1derx(1,lll,kkk,iii,2,2))
5954 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5955 & AEAb2derx(1,lll,kkk,iii,2,2))
5964 C---------------------------------------------------------------------------
5965 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5966 & KK,KKderg,AKA,AKAderg,AKAderx)
5970 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5971 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5972 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5977 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5979 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5982 cd if (lprn) write (2,*) 'In kernel'
5984 cd if (lprn) write (2,*) 'kkk=',kkk
5986 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5987 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5989 cd write (2,*) 'lll=',lll
5990 cd write (2,*) 'iii=1'
5992 cd write (2,'(3(2f10.5),5x)')
5993 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5996 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5997 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5999 cd write (2,*) 'lll=',lll
6000 cd write (2,*) 'iii=2'
6002 cd write (2,'(3(2f10.5),5x)')
6003 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6010 C---------------------------------------------------------------------------
6011 double precision function eello4(i,j,k,l,jj,kk)
6012 implicit real*8 (a-h,o-z)
6013 include 'DIMENSIONS'
6014 include 'DIMENSIONS.ZSCOPT'
6015 include 'COMMON.IOUNITS'
6016 include 'COMMON.CHAIN'
6017 include 'COMMON.DERIV'
6018 include 'COMMON.INTERACT'
6019 include 'COMMON.CONTACTS'
6020 include 'COMMON.TORSION'
6021 include 'COMMON.VAR'
6022 include 'COMMON.GEO'
6023 double precision pizda(2,2),ggg1(3),ggg2(3)
6024 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6028 cd print *,'eello4:',i,j,k,l,jj,kk
6029 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6030 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6031 cold eij=facont_hb(jj,i)
6032 cold ekl=facont_hb(kk,k)
6034 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6036 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6037 gcorr_loc(k-1)=gcorr_loc(k-1)
6038 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6040 gcorr_loc(l-1)=gcorr_loc(l-1)
6041 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6043 gcorr_loc(j-1)=gcorr_loc(j-1)
6044 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6049 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6050 & -EAEAderx(2,2,lll,kkk,iii,1)
6051 cd derx(lll,kkk,iii)=0.0d0
6055 cd gcorr_loc(l-1)=0.0d0
6056 cd gcorr_loc(j-1)=0.0d0
6057 cd gcorr_loc(k-1)=0.0d0
6059 cd write (iout,*)'Contacts have occurred for peptide groups',
6060 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6061 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6062 if (j.lt.nres-1) then
6069 if (l.lt.nres-1) then
6077 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6078 ggg1(ll)=eel4*g_contij(ll,1)
6079 ggg2(ll)=eel4*g_contij(ll,2)
6080 ghalf=0.5d0*ggg1(ll)
6082 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6083 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6084 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6085 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6086 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6087 ghalf=0.5d0*ggg2(ll)
6089 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6090 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6091 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6092 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6097 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6098 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6103 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6104 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6110 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6115 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6119 cd write (2,*) iii,gcorr_loc(iii)
6123 cd write (2,*) 'ekont',ekont
6124 cd write (iout,*) 'eello4',ekont*eel4
6127 C---------------------------------------------------------------------------
6128 double precision function eello5(i,j,k,l,jj,kk)
6129 implicit real*8 (a-h,o-z)
6130 include 'DIMENSIONS'
6131 include 'DIMENSIONS.ZSCOPT'
6132 include 'COMMON.IOUNITS'
6133 include 'COMMON.CHAIN'
6134 include 'COMMON.DERIV'
6135 include 'COMMON.INTERACT'
6136 include 'COMMON.CONTACTS'
6137 include 'COMMON.TORSION'
6138 include 'COMMON.VAR'
6139 include 'COMMON.GEO'
6140 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6141 double precision ggg1(3),ggg2(3)
6142 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6147 C /l\ / \ \ / \ / \ / C
6148 C / \ / \ \ / \ / \ / C
6149 C j| o |l1 | o | o| o | | o |o C
6150 C \ |/k\| |/ \| / |/ \| |/ \| C
6151 C \i/ \ / \ / / \ / \ C
6153 C (I) (II) (III) (IV) C
6155 C eello5_1 eello5_2 eello5_3 eello5_4 C
6157 C Antiparallel chains C
6160 C /j\ / \ \ / \ / \ / C
6161 C / \ / \ \ / \ / \ / C
6162 C j1| o |l | o | o| o | | o |o C
6163 C \ |/k\| |/ \| / |/ \| |/ \| C
6164 C \i/ \ / \ / / \ / \ C
6166 C (I) (II) (III) (IV) C
6168 C eello5_1 eello5_2 eello5_3 eello5_4 C
6170 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6172 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6173 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6178 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6180 itk=itortyp(itype(k))
6181 itl=itortyp(itype(l))
6182 itj=itortyp(itype(j))
6187 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6188 cd & eel5_3_num,eel5_4_num)
6192 derx(lll,kkk,iii)=0.0d0
6196 cd eij=facont_hb(jj,i)
6197 cd ekl=facont_hb(kk,k)
6199 cd write (iout,*)'Contacts have occurred for peptide groups',
6200 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6202 C Contribution from the graph I.
6203 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6204 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6205 call transpose2(EUg(1,1,k),auxmat(1,1))
6206 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6207 vv(1)=pizda(1,1)-pizda(2,2)
6208 vv(2)=pizda(1,2)+pizda(2,1)
6209 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6210 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6212 C Explicit gradient in virtual-dihedral angles.
6213 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6214 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6215 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6216 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6217 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6218 vv(1)=pizda(1,1)-pizda(2,2)
6219 vv(2)=pizda(1,2)+pizda(2,1)
6220 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6221 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6222 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6223 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6224 vv(1)=pizda(1,1)-pizda(2,2)
6225 vv(2)=pizda(1,2)+pizda(2,1)
6227 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6228 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6229 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6231 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6232 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6233 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6235 C Cartesian gradient
6239 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6241 vv(1)=pizda(1,1)-pizda(2,2)
6242 vv(2)=pizda(1,2)+pizda(2,1)
6243 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6244 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6245 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6252 C Contribution from graph II
6253 call transpose2(EE(1,1,itk),auxmat(1,1))
6254 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6255 vv(1)=pizda(1,1)+pizda(2,2)
6256 vv(2)=pizda(2,1)-pizda(1,2)
6257 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6258 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6260 C Explicit gradient in virtual-dihedral angles.
6261 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6262 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6263 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6264 vv(1)=pizda(1,1)+pizda(2,2)
6265 vv(2)=pizda(2,1)-pizda(1,2)
6267 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6268 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6269 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6271 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6272 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6273 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6275 C Cartesian gradient
6279 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6281 vv(1)=pizda(1,1)+pizda(2,2)
6282 vv(2)=pizda(2,1)-pizda(1,2)
6283 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6284 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6285 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6294 C Parallel orientation
6295 C Contribution from graph III
6296 call transpose2(EUg(1,1,l),auxmat(1,1))
6297 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6298 vv(1)=pizda(1,1)-pizda(2,2)
6299 vv(2)=pizda(1,2)+pizda(2,1)
6300 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6301 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6303 C Explicit gradient in virtual-dihedral angles.
6304 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6305 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6306 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6307 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6308 vv(1)=pizda(1,1)-pizda(2,2)
6309 vv(2)=pizda(1,2)+pizda(2,1)
6310 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6311 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6312 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6313 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6314 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6315 vv(1)=pizda(1,1)-pizda(2,2)
6316 vv(2)=pizda(1,2)+pizda(2,1)
6317 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6318 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6319 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6320 C Cartesian gradient
6324 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6326 vv(1)=pizda(1,1)-pizda(2,2)
6327 vv(2)=pizda(1,2)+pizda(2,1)
6328 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6329 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6330 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6336 C Contribution from graph IV
6338 call transpose2(EE(1,1,itl),auxmat(1,1))
6339 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6340 vv(1)=pizda(1,1)+pizda(2,2)
6341 vv(2)=pizda(2,1)-pizda(1,2)
6342 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6343 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6345 C Explicit gradient in virtual-dihedral angles.
6346 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6347 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6348 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6349 vv(1)=pizda(1,1)+pizda(2,2)
6350 vv(2)=pizda(2,1)-pizda(1,2)
6351 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6352 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6353 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6354 C Cartesian gradient
6358 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6360 vv(1)=pizda(1,1)+pizda(2,2)
6361 vv(2)=pizda(2,1)-pizda(1,2)
6362 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6363 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6364 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6370 C Antiparallel orientation
6371 C Contribution from graph III
6373 call transpose2(EUg(1,1,j),auxmat(1,1))
6374 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6375 vv(1)=pizda(1,1)-pizda(2,2)
6376 vv(2)=pizda(1,2)+pizda(2,1)
6377 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6378 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6380 C Explicit gradient in virtual-dihedral angles.
6381 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6382 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6383 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6384 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6385 vv(1)=pizda(1,1)-pizda(2,2)
6386 vv(2)=pizda(1,2)+pizda(2,1)
6387 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6388 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6389 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6390 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6391 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6392 vv(1)=pizda(1,1)-pizda(2,2)
6393 vv(2)=pizda(1,2)+pizda(2,1)
6394 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6395 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6396 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6397 C Cartesian gradient
6401 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6403 vv(1)=pizda(1,1)-pizda(2,2)
6404 vv(2)=pizda(1,2)+pizda(2,1)
6405 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6406 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6407 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6413 C Contribution from graph IV
6415 call transpose2(EE(1,1,itj),auxmat(1,1))
6416 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6417 vv(1)=pizda(1,1)+pizda(2,2)
6418 vv(2)=pizda(2,1)-pizda(1,2)
6419 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6420 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6422 C Explicit gradient in virtual-dihedral angles.
6423 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6424 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6425 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6426 vv(1)=pizda(1,1)+pizda(2,2)
6427 vv(2)=pizda(2,1)-pizda(1,2)
6428 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6429 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6430 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6431 C Cartesian gradient
6435 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6437 vv(1)=pizda(1,1)+pizda(2,2)
6438 vv(2)=pizda(2,1)-pizda(1,2)
6439 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6440 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6441 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6448 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6449 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6450 cd write (2,*) 'ijkl',i,j,k,l
6451 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6452 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6454 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6455 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6456 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6457 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6459 if (j.lt.nres-1) then
6466 if (l.lt.nres-1) then
6476 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6478 ggg1(ll)=eel5*g_contij(ll,1)
6479 ggg2(ll)=eel5*g_contij(ll,2)
6480 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6481 ghalf=0.5d0*ggg1(ll)
6483 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6484 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6485 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6486 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6487 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6488 ghalf=0.5d0*ggg2(ll)
6490 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6491 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6492 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6493 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6498 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6499 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6504 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6505 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6511 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6516 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6520 cd write (2,*) iii,g_corr5_loc(iii)
6524 cd write (2,*) 'ekont',ekont
6525 cd write (iout,*) 'eello5',ekont*eel5
6528 c--------------------------------------------------------------------------
6529 double precision function eello6(i,j,k,l,jj,kk)
6530 implicit real*8 (a-h,o-z)
6531 include 'DIMENSIONS'
6532 include 'DIMENSIONS.ZSCOPT'
6533 include 'COMMON.IOUNITS'
6534 include 'COMMON.CHAIN'
6535 include 'COMMON.DERIV'
6536 include 'COMMON.INTERACT'
6537 include 'COMMON.CONTACTS'
6538 include 'COMMON.TORSION'
6539 include 'COMMON.VAR'
6540 include 'COMMON.GEO'
6541 include 'COMMON.FFIELD'
6542 double precision ggg1(3),ggg2(3)
6543 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6548 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6556 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6557 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6561 derx(lll,kkk,iii)=0.0d0
6565 cd eij=facont_hb(jj,i)
6566 cd ekl=facont_hb(kk,k)
6572 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6573 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6574 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6575 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6576 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6577 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6579 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6580 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6581 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6582 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6583 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6584 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6588 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6590 C If turn contributions are considered, they will be handled separately.
6591 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6592 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6593 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6594 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6595 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6596 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6597 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6600 if (j.lt.nres-1) then
6607 if (l.lt.nres-1) then
6615 ggg1(ll)=eel6*g_contij(ll,1)
6616 ggg2(ll)=eel6*g_contij(ll,2)
6617 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6618 ghalf=0.5d0*ggg1(ll)
6620 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6621 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6622 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6623 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6624 ghalf=0.5d0*ggg2(ll)
6625 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6627 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6628 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6629 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6630 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6635 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6636 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6641 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6642 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6648 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6653 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6657 cd write (2,*) iii,g_corr6_loc(iii)
6661 cd write (2,*) 'ekont',ekont
6662 cd write (iout,*) 'eello6',ekont*eel6
6665 c--------------------------------------------------------------------------
6666 double precision function eello6_graph1(i,j,k,l,imat,swap)
6667 implicit real*8 (a-h,o-z)
6668 include 'DIMENSIONS'
6669 include 'DIMENSIONS.ZSCOPT'
6670 include 'COMMON.IOUNITS'
6671 include 'COMMON.CHAIN'
6672 include 'COMMON.DERIV'
6673 include 'COMMON.INTERACT'
6674 include 'COMMON.CONTACTS'
6675 include 'COMMON.TORSION'
6676 include 'COMMON.VAR'
6677 include 'COMMON.GEO'
6678 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6682 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6684 C Parallel Antiparallel C
6690 C \ j|/k\| / \ |/k\|l / C
6695 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6696 itk=itortyp(itype(k))
6697 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6698 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6699 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6700 call transpose2(EUgC(1,1,k),auxmat(1,1))
6701 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6702 vv1(1)=pizda1(1,1)-pizda1(2,2)
6703 vv1(2)=pizda1(1,2)+pizda1(2,1)
6704 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6705 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6706 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6707 s5=scalar2(vv(1),Dtobr2(1,i))
6708 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6709 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6710 if (.not. calc_grad) return
6711 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6712 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6713 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6714 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6715 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6716 & +scalar2(vv(1),Dtobr2der(1,i)))
6717 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6718 vv1(1)=pizda1(1,1)-pizda1(2,2)
6719 vv1(2)=pizda1(1,2)+pizda1(2,1)
6720 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6721 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6723 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6724 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6725 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6726 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6727 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6729 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6730 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6731 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6732 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6733 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6735 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6736 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6737 vv1(1)=pizda1(1,1)-pizda1(2,2)
6738 vv1(2)=pizda1(1,2)+pizda1(2,1)
6739 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6740 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6741 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6742 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6751 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6752 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6753 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6754 call transpose2(EUgC(1,1,k),auxmat(1,1))
6755 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6757 vv1(1)=pizda1(1,1)-pizda1(2,2)
6758 vv1(2)=pizda1(1,2)+pizda1(2,1)
6759 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6760 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6761 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6762 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6763 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6764 s5=scalar2(vv(1),Dtobr2(1,i))
6765 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6771 c----------------------------------------------------------------------------
6772 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6773 implicit real*8 (a-h,o-z)
6774 include 'DIMENSIONS'
6775 include 'DIMENSIONS.ZSCOPT'
6776 include 'COMMON.IOUNITS'
6777 include 'COMMON.CHAIN'
6778 include 'COMMON.DERIV'
6779 include 'COMMON.INTERACT'
6780 include 'COMMON.CONTACTS'
6781 include 'COMMON.TORSION'
6782 include 'COMMON.VAR'
6783 include 'COMMON.GEO'
6785 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6786 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6789 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6791 C Parallel Antiparallel C
6797 C \ j|/k\| \ |/k\|l C
6802 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6803 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6804 C AL 7/4/01 s1 would occur in the sixth-order moment,
6805 C but not in a cluster cumulant
6807 s1=dip(1,jj,i)*dip(1,kk,k)
6809 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6810 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6811 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6812 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6813 call transpose2(EUg(1,1,k),auxmat(1,1))
6814 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6815 vv(1)=pizda(1,1)-pizda(2,2)
6816 vv(2)=pizda(1,2)+pizda(2,1)
6817 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6818 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6820 eello6_graph2=-(s1+s2+s3+s4)
6822 eello6_graph2=-(s2+s3+s4)
6825 if (.not. calc_grad) return
6826 C Derivatives in gamma(i-1)
6829 s1=dipderg(1,jj,i)*dip(1,kk,k)
6831 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6832 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6833 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6834 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6836 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6838 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6840 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6842 C Derivatives in gamma(k-1)
6844 s1=dip(1,jj,i)*dipderg(1,kk,k)
6846 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6847 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6848 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6849 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6850 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6851 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6852 vv(1)=pizda(1,1)-pizda(2,2)
6853 vv(2)=pizda(1,2)+pizda(2,1)
6854 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6856 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6858 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6860 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6861 C Derivatives in gamma(j-1) or gamma(l-1)
6864 s1=dipderg(3,jj,i)*dip(1,kk,k)
6866 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6867 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6868 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6869 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6870 vv(1)=pizda(1,1)-pizda(2,2)
6871 vv(2)=pizda(1,2)+pizda(2,1)
6872 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6875 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6877 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6880 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6881 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6883 C Derivatives in gamma(l-1) or gamma(j-1)
6886 s1=dip(1,jj,i)*dipderg(3,kk,k)
6888 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6889 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6890 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6891 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6892 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6893 vv(1)=pizda(1,1)-pizda(2,2)
6894 vv(2)=pizda(1,2)+pizda(2,1)
6895 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6898 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6900 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6903 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6904 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6906 C Cartesian derivatives.
6908 write (2,*) 'In eello6_graph2'
6910 write (2,*) 'iii=',iii
6912 write (2,*) 'kkk=',kkk
6914 write (2,'(3(2f10.5),5x)')
6915 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6925 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6927 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6930 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6932 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6933 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6935 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6936 call transpose2(EUg(1,1,k),auxmat(1,1))
6937 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6939 vv(1)=pizda(1,1)-pizda(2,2)
6940 vv(2)=pizda(1,2)+pizda(2,1)
6941 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6942 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6944 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6946 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6949 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6951 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6958 c----------------------------------------------------------------------------
6959 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6960 implicit real*8 (a-h,o-z)
6961 include 'DIMENSIONS'
6962 include 'DIMENSIONS.ZSCOPT'
6963 include 'COMMON.IOUNITS'
6964 include 'COMMON.CHAIN'
6965 include 'COMMON.DERIV'
6966 include 'COMMON.INTERACT'
6967 include 'COMMON.CONTACTS'
6968 include 'COMMON.TORSION'
6969 include 'COMMON.VAR'
6970 include 'COMMON.GEO'
6971 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6973 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6975 C Parallel Antiparallel C
6981 C j|/k\| / |/k\|l / C
6986 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6988 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6989 C energy moment and not to the cluster cumulant.
6990 iti=itortyp(itype(i))
6991 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6992 itj1=itortyp(itype(j+1))
6996 itk=itortyp(itype(k))
6997 itk1=itortyp(itype(k+1))
6998 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6999 itl1=itortyp(itype(l+1))
7004 s1=dip(4,jj,i)*dip(4,kk,k)
7006 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7007 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7008 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7009 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7010 call transpose2(EE(1,1,itk),auxmat(1,1))
7011 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7012 vv(1)=pizda(1,1)+pizda(2,2)
7013 vv(2)=pizda(2,1)-pizda(1,2)
7014 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7015 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7017 eello6_graph3=-(s1+s2+s3+s4)
7019 eello6_graph3=-(s2+s3+s4)
7022 if (.not. calc_grad) return
7023 C Derivatives in gamma(k-1)
7024 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7025 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7026 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7027 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7028 C Derivatives in gamma(l-1)
7029 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7030 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7031 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7032 vv(1)=pizda(1,1)+pizda(2,2)
7033 vv(2)=pizda(2,1)-pizda(1,2)
7034 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7035 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7036 C Cartesian derivatives.
7042 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7044 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7047 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7049 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7050 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7052 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7053 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7055 vv(1)=pizda(1,1)+pizda(2,2)
7056 vv(2)=pizda(2,1)-pizda(1,2)
7057 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7059 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7061 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7064 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7066 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7068 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7074 c----------------------------------------------------------------------------
7075 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7076 implicit real*8 (a-h,o-z)
7077 include 'DIMENSIONS'
7078 include 'DIMENSIONS.ZSCOPT'
7079 include 'COMMON.IOUNITS'
7080 include 'COMMON.CHAIN'
7081 include 'COMMON.DERIV'
7082 include 'COMMON.INTERACT'
7083 include 'COMMON.CONTACTS'
7084 include 'COMMON.TORSION'
7085 include 'COMMON.VAR'
7086 include 'COMMON.GEO'
7087 include 'COMMON.FFIELD'
7088 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7089 & auxvec1(2),auxmat1(2,2)
7091 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7093 C Parallel Antiparallel C
7099 C \ j|/k\| \ |/k\|l C
7104 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7106 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7107 C energy moment and not to the cluster cumulant.
7108 cd write (2,*) 'eello_graph4: wturn6',wturn6
7109 iti=itortyp(itype(i))
7110 itj=itortyp(itype(j))
7111 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7112 itj1=itortyp(itype(j+1))
7116 itk=itortyp(itype(k))
7117 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7118 itk1=itortyp(itype(k+1))
7122 itl=itortyp(itype(l))
7123 if (l.lt.nres-1) then
7124 itl1=itortyp(itype(l+1))
7128 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7129 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7130 cd & ' itl',itl,' itl1',itl1
7133 s1=dip(3,jj,i)*dip(3,kk,k)
7135 s1=dip(2,jj,j)*dip(2,kk,l)
7138 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7139 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7141 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7142 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7144 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7145 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7147 call transpose2(EUg(1,1,k),auxmat(1,1))
7148 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7149 vv(1)=pizda(1,1)-pizda(2,2)
7150 vv(2)=pizda(2,1)+pizda(1,2)
7151 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7152 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7154 eello6_graph4=-(s1+s2+s3+s4)
7156 eello6_graph4=-(s2+s3+s4)
7158 if (.not. calc_grad) return
7159 C Derivatives in gamma(i-1)
7163 s1=dipderg(2,jj,i)*dip(3,kk,k)
7165 s1=dipderg(4,jj,j)*dip(2,kk,l)
7168 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7170 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7171 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7173 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7174 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7176 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7177 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7178 cd write (2,*) 'turn6 derivatives'
7180 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7182 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7186 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7188 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7192 C Derivatives in gamma(k-1)
7195 s1=dip(3,jj,i)*dipderg(2,kk,k)
7197 s1=dip(2,jj,j)*dipderg(4,kk,l)
7200 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7201 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7203 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7204 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7206 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7207 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7209 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7210 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7211 vv(1)=pizda(1,1)-pizda(2,2)
7212 vv(2)=pizda(2,1)+pizda(1,2)
7213 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7214 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7216 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7218 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7222 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7224 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7227 C Derivatives in gamma(j-1) or gamma(l-1)
7228 if (l.eq.j+1 .and. l.gt.1) then
7229 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7230 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7231 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7232 vv(1)=pizda(1,1)-pizda(2,2)
7233 vv(2)=pizda(2,1)+pizda(1,2)
7234 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7235 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7236 else if (j.gt.1) then
7237 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7238 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7239 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7240 vv(1)=pizda(1,1)-pizda(2,2)
7241 vv(2)=pizda(2,1)+pizda(1,2)
7242 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7243 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7244 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7246 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7249 C Cartesian derivatives.
7256 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7258 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7262 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7264 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7268 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7270 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7272 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7273 & b1(1,itj1),auxvec(1))
7274 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7276 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7277 & b1(1,itl1),auxvec(1))
7278 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7280 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7282 vv(1)=pizda(1,1)-pizda(2,2)
7283 vv(2)=pizda(2,1)+pizda(1,2)
7284 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7286 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7288 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7291 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7294 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7297 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7299 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7301 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7305 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7307 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7310 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7312 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7320 c----------------------------------------------------------------------------
7321 double precision function eello_turn6(i,jj,kk)
7322 implicit real*8 (a-h,o-z)
7323 include 'DIMENSIONS'
7324 include 'DIMENSIONS.ZSCOPT'
7325 include 'COMMON.IOUNITS'
7326 include 'COMMON.CHAIN'
7327 include 'COMMON.DERIV'
7328 include 'COMMON.INTERACT'
7329 include 'COMMON.CONTACTS'
7330 include 'COMMON.TORSION'
7331 include 'COMMON.VAR'
7332 include 'COMMON.GEO'
7333 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7334 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7336 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7337 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7338 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7339 C the respective energy moment and not to the cluster cumulant.
7344 iti=itortyp(itype(i))
7345 itk=itortyp(itype(k))
7346 itk1=itortyp(itype(k+1))
7347 itl=itortyp(itype(l))
7348 itj=itortyp(itype(j))
7349 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7350 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7351 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7356 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7358 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7362 derx_turn(lll,kkk,iii)=0.0d0
7369 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7371 cd write (2,*) 'eello6_5',eello6_5
7373 call transpose2(AEA(1,1,1),auxmat(1,1))
7374 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7375 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7376 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7380 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7381 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7382 s2 = scalar2(b1(1,itk),vtemp1(1))
7384 call transpose2(AEA(1,1,2),atemp(1,1))
7385 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7386 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7387 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7391 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7392 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7393 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7395 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7396 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7397 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7398 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7399 ss13 = scalar2(b1(1,itk),vtemp4(1))
7400 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7404 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7410 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7412 C Derivatives in gamma(i+2)
7414 call transpose2(AEA(1,1,1),auxmatd(1,1))
7415 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7416 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7417 call transpose2(AEAderg(1,1,2),atempd(1,1))
7418 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7419 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7423 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7424 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7425 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7431 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7432 C Derivatives in gamma(i+3)
7434 call transpose2(AEA(1,1,1),auxmatd(1,1))
7435 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7436 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7437 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7441 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7442 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7443 s2d = scalar2(b1(1,itk),vtemp1d(1))
7445 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7446 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7448 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7450 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7451 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7452 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7462 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7463 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7465 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7466 & -0.5d0*ekont*(s2d+s12d)
7468 C Derivatives in gamma(i+4)
7469 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7470 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7471 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7473 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7474 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7475 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7485 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7487 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7489 C Derivatives in gamma(i+5)
7491 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7492 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7493 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7497 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7498 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7499 s2d = scalar2(b1(1,itk),vtemp1d(1))
7501 call transpose2(AEA(1,1,2),atempd(1,1))
7502 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7503 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7507 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7508 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7510 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7511 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7512 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7522 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7523 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7525 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7526 & -0.5d0*ekont*(s2d+s12d)
7528 C Cartesian derivatives
7533 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7534 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7535 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7539 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7540 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7542 s2d = scalar2(b1(1,itk),vtemp1d(1))
7544 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7545 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7546 s8d = -(atempd(1,1)+atempd(2,2))*
7547 & scalar2(cc(1,1,itl),vtemp2(1))
7551 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7553 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7554 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7561 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7564 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7568 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7569 & - 0.5d0*(s8d+s12d)
7571 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7580 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7582 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7583 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7584 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7585 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7586 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7588 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7589 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7590 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7594 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7595 cd & 16*eel_turn6_num
7597 if (j.lt.nres-1) then
7604 if (l.lt.nres-1) then
7612 ggg1(ll)=eel_turn6*g_contij(ll,1)
7613 ggg2(ll)=eel_turn6*g_contij(ll,2)
7614 ghalf=0.5d0*ggg1(ll)
7616 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7617 & +ekont*derx_turn(ll,2,1)
7618 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7619 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7620 & +ekont*derx_turn(ll,4,1)
7621 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7622 ghalf=0.5d0*ggg2(ll)
7624 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7625 & +ekont*derx_turn(ll,2,2)
7626 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7627 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7628 & +ekont*derx_turn(ll,4,2)
7629 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7634 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7639 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7645 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7650 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7654 cd write (2,*) iii,g_corr6_loc(iii)
7657 eello_turn6=ekont*eel_turn6
7658 cd write (2,*) 'ekont',ekont
7659 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7662 crc-------------------------------------------------
7663 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7664 subroutine Eliptransfer(eliptran)
7665 implicit real*8 (a-h,o-z)
7666 include 'DIMENSIONS'
7667 include 'COMMON.GEO'
7668 include 'COMMON.VAR'
7669 include 'COMMON.LOCAL'
7670 include 'COMMON.CHAIN'
7671 include 'COMMON.DERIV'
7672 include 'COMMON.INTERACT'
7673 include 'COMMON.IOUNITS'
7674 include 'COMMON.CALC'
7675 include 'COMMON.CONTROL'
7676 include 'COMMON.SPLITELE'
7677 include 'COMMON.SBRIDGE'
7678 C this is done by Adasko
7682 C--bordliptop-- buffore starts
7683 C--bufliptop--- here true lipid starts
7685 C--buflipbot--- lipid ends buffore starts
7686 C--bordlipbot--buffore ends
7690 if (itype(i).eq.ntyp1) cycle
7692 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
7693 if (positi.le.0) positi=positi+boxzsize
7695 C first for peptide groups
7696 c for each residue check if it is in lipid or lipid water border area
7697 if ((positi.gt.bordlipbot)
7698 &.and.(positi.lt.bordliptop)) then
7699 C the energy transfer exist
7700 if (positi.lt.buflipbot) then
7701 C what fraction I am in
7703 & ((positi-bordlipbot)/lipbufthick)
7704 C lipbufthick is thickenes of lipid buffore
7705 sslip=sscalelip(fracinbuf)
7706 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
7707 eliptran=eliptran+sslip*pepliptran
7708 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
7709 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
7710 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
7711 elseif (positi.gt.bufliptop) then
7712 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
7713 sslip=sscalelip(fracinbuf)
7714 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
7715 eliptran=eliptran+sslip*pepliptran
7716 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
7717 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
7718 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
7719 C print *, "doing sscalefor top part"
7720 C print *,i,sslip,fracinbuf,ssgradlip
7722 eliptran=eliptran+pepliptran
7723 C print *,"I am in true lipid"
7726 C eliptran=elpitran+0.0 ! I am in water
7729 C print *, "nic nie bylo w lipidzie?"
7730 C now multiply all by the peptide group transfer factor
7731 C eliptran=eliptran*pepliptran
7732 C now the same for side chains
7735 if (itype(i).eq.ntyp1) cycle
7736 positi=(mod(c(3,i+nres),boxzsize))
7737 if (positi.le.0) positi=positi+boxzsize
7738 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
7739 c for each residue check if it is in lipid or lipid water border area
7740 C respos=mod(c(3,i+nres),boxzsize)
7741 C print *,positi,bordlipbot,buflipbot
7742 if ((positi.gt.bordlipbot)
7743 & .and.(positi.lt.bordliptop)) then
7744 C the energy transfer exist
7745 if (positi.lt.buflipbot) then
7747 & ((positi-bordlipbot)/lipbufthick)
7748 C lipbufthick is thickenes of lipid buffore
7749 sslip=sscalelip(fracinbuf)
7750 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
7751 eliptran=eliptran+sslip*liptranene(itype(i))
7752 gliptranx(3,i)=gliptranx(3,i)
7753 &+ssgradlip*liptranene(itype(i))
7754 gliptranc(3,i-1)= gliptranc(3,i-1)
7755 &+ssgradlip*liptranene(itype(i))
7756 C print *,"doing sccale for lower part"
7757 elseif (positi.gt.bufliptop) then
7759 &((bordliptop-positi)/lipbufthick)
7760 sslip=sscalelip(fracinbuf)
7761 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
7762 eliptran=eliptran+sslip*liptranene(itype(i))
7763 gliptranx(3,i)=gliptranx(3,i)
7764 &+ssgradlip*liptranene(itype(i))
7765 gliptranc(3,i-1)= gliptranc(3,i-1)
7766 &+ssgradlip*liptranene(itype(i))
7767 C print *, "doing sscalefor top part",sslip,fracinbuf
7769 eliptran=eliptran+liptranene(itype(i))
7770 C print *,"I am in true lipid"
7772 endif ! if in lipid or buffor
7774 C eliptran=elpitran+0.0 ! I am in water
7780 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7782 SUBROUTINE MATVEC2(A1,V1,V2)
7783 implicit real*8 (a-h,o-z)
7784 include 'DIMENSIONS'
7785 DIMENSION A1(2,2),V1(2),V2(2)
7789 c 3 VI=VI+A1(I,K)*V1(K)
7793 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7794 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7799 C---------------------------------------
7800 SUBROUTINE MATMAT2(A1,A2,A3)
7801 implicit real*8 (a-h,o-z)
7802 include 'DIMENSIONS'
7803 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7804 c DIMENSION AI3(2,2)
7808 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7814 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7815 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7816 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7817 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7825 c-------------------------------------------------------------------------
7826 double precision function scalar2(u,v)
7828 double precision u(2),v(2)
7831 scalar2=u(1)*v(1)+u(2)*v(2)
7835 C-----------------------------------------------------------------------------
7837 subroutine transpose2(a,at)
7839 double precision a(2,2),at(2,2)
7846 c--------------------------------------------------------------------------
7847 subroutine transpose(n,a,at)
7850 double precision a(n,n),at(n,n)
7858 C---------------------------------------------------------------------------
7859 subroutine prodmat3(a1,a2,kk,transp,prod)
7862 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7864 crc double precision auxmat(2,2),prod_(2,2)
7867 crc call transpose2(kk(1,1),auxmat(1,1))
7868 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7869 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7871 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7872 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7873 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7874 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7875 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7876 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7877 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7878 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7881 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7882 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7884 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7885 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7886 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7887 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7888 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7889 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7890 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7891 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7894 c call transpose2(a2(1,1),a2t(1,1))
7897 crc print *,((prod_(i,j),i=1,2),j=1,2)
7898 crc print *,((prod(i,j),i=1,2),j=1,2)
7902 C-----------------------------------------------------------------------------
7903 double precision function scalar(u,v)
7905 double precision u(3),v(3)
7915 C-----------------------------------------------------------------------
7916 double precision function sscale(r)
7917 double precision r,gamm
7918 include "COMMON.SPLITELE"
7919 if(r.lt.r_cut-rlamb) then
7921 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7922 gamm=(r-(r_cut-rlamb))/rlamb
7923 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
7929 C-----------------------------------------------------------------------
7930 C-----------------------------------------------------------------------
7931 double precision function sscagrad(r)
7932 double precision r,gamm
7933 include "COMMON.SPLITELE"
7934 if(r.lt.r_cut-rlamb) then
7936 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7937 gamm=(r-(r_cut-rlamb))/rlamb
7938 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
7944 C-----------------------------------------------------------------------
7945 C-----------------------------------------------------------------------
7946 double precision function sscalelip(r)
7947 double precision r,gamm
7948 include "COMMON.SPLITELE"
7949 C if(r.lt.r_cut-rlamb) then
7951 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7952 C gamm=(r-(r_cut-rlamb))/rlamb
7953 sscalelip=1.0d0+r*r*(2*r-3.0d0)
7959 C-----------------------------------------------------------------------
7960 double precision function sscagradlip(r)
7961 double precision r,gamm
7962 include "COMMON.SPLITELE"
7963 C if(r.lt.r_cut-rlamb) then
7965 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7966 C gamm=(r-(r_cut-rlamb))/rlamb
7967 sscagradlip=r*(6*r-6.0d0)
7974 C-----------------------------------------------------------------------