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 C 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 write (iout,*) 'mumu',i,b1(1,iti),Ub2(1,i-2)
1848 C Vectors and matrices dependent on a single virtual-bond dihedral.
1849 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1850 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1851 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1852 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1853 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1854 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1855 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1856 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1857 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1858 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1859 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1861 C Matrices dependent on two consecutive virtual-bond dihedrals.
1862 C The order of matrices is from left to right.
1864 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1865 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1866 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1867 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1868 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1869 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1870 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1871 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1874 cd iti = itortyp(itype(i))
1877 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1878 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1883 C--------------------------------------------------------------------------
1884 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1886 C This subroutine calculates the average interaction energy and its gradient
1887 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1888 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1889 C The potential depends both on the distance of peptide-group centers and on
1890 C the orientation of the CA-CA virtual bonds.
1892 implicit real*8 (a-h,o-z)
1893 include 'DIMENSIONS'
1894 include 'DIMENSIONS.ZSCOPT'
1895 include 'COMMON.CONTROL'
1896 include 'COMMON.IOUNITS'
1897 include 'COMMON.GEO'
1898 include 'COMMON.VAR'
1899 include 'COMMON.LOCAL'
1900 include 'COMMON.CHAIN'
1901 include 'COMMON.DERIV'
1902 include 'COMMON.INTERACT'
1903 include 'COMMON.CONTACTS'
1904 include 'COMMON.TORSION'
1905 include 'COMMON.VECTORS'
1906 include 'COMMON.FFIELD'
1907 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1908 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1909 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1910 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1911 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1912 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1913 double precision scal_el /0.5d0/
1915 C 13-go grudnia roku pamietnego...
1916 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1917 & 0.0d0,1.0d0,0.0d0,
1918 & 0.0d0,0.0d0,1.0d0/
1919 cd write(iout,*) 'In EELEC'
1921 cd write(iout,*) 'Type',i
1922 cd write(iout,*) 'B1',B1(:,i)
1923 cd write(iout,*) 'B2',B2(:,i)
1924 cd write(iout,*) 'CC',CC(:,:,i)
1925 cd write(iout,*) 'DD',DD(:,:,i)
1926 cd write(iout,*) 'EE',EE(:,:,i)
1928 cd call check_vecgrad
1930 if (icheckgrad.eq.1) then
1932 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1934 dc_norm(k,i)=dc(k,i)*fac
1936 c write (iout,*) 'i',i,' fac',fac
1939 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1940 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1941 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1942 cd if (wel_loc.gt.0.0d0) then
1943 if (icheckgrad.eq.1) then
1944 call vec_and_deriv_test
1951 cd write (iout,*) 'i=',i
1953 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1956 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1957 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1970 C print '(a)','Enter EELEC'
1971 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1973 gel_loc_loc(i)=0.0d0
1976 do i=iatel_s,iatel_e
1978 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
1979 & .or. itype(i+2).eq.ntyp1) cycle
1981 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
1982 & .or. itype(i+2).eq.ntyp1
1983 & .or. itype(i-1).eq.ntyp1
1986 if (itel(i).eq.0) goto 1215
1990 dx_normi=dc_norm(1,i)
1991 dy_normi=dc_norm(2,i)
1992 dz_normi=dc_norm(3,i)
1993 xmedi=c(1,i)+0.5d0*dxi
1994 ymedi=c(2,i)+0.5d0*dyi
1995 zmedi=c(3,i)+0.5d0*dzi
1996 xmedi=mod(xmedi,boxxsize)
1997 if (xmedi.lt.0) xmedi=xmedi+boxxsize
1998 ymedi=mod(ymedi,boxysize)
1999 if (ymedi.lt.0) ymedi=ymedi+boxysize
2000 zmedi=mod(zmedi,boxzsize)
2001 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2003 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2004 do j=ielstart(i),ielend(i)
2006 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2007 & .or.itype(j+2).eq.ntyp1
2010 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2011 & .or.itype(j+2).eq.ntyp1
2012 & .or.itype(j-1).eq.ntyp1
2017 if (itel(j).eq.0) goto 1216
2021 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2022 aaa=app(iteli,itelj)
2023 bbb=bpp(iteli,itelj)
2024 C Diagnostics only!!!
2030 ael6i=ael6(iteli,itelj)
2031 ael3i=ael3(iteli,itelj)
2035 dx_normj=dc_norm(1,j)
2036 dy_normj=dc_norm(2,j)
2037 dz_normj=dc_norm(3,j)
2042 if (xj.lt.0) xj=xj+boxxsize
2044 if (yj.lt.0) yj=yj+boxysize
2046 if (zj.lt.0) zj=zj+boxzsize
2047 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2055 xj=xj_safe+xshift*boxxsize
2056 yj=yj_safe+yshift*boxysize
2057 zj=zj_safe+zshift*boxzsize
2058 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2059 if(dist_temp.lt.dist_init) then
2069 if (isubchap.eq.1) then
2078 rij=xj*xj+yj*yj+zj*zj
2079 sss=sscale(sqrt(rij))
2080 sssgrad=sscagrad(sqrt(rij))
2086 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2087 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2088 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2089 fac=cosa-3.0D0*cosb*cosg
2091 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2092 if (j.eq.i+2) ev1=scal_el*ev1
2097 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2100 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2101 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2102 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2104 evdw1=evdw1+evdwij*sss
2105 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2106 c &'evdw1',i,j,evdwij
2107 c &,iteli,itelj,aaa,evdw1
2109 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2110 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2111 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2112 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2113 c & xmedi,ymedi,zmedi,xj,yj,zj
2115 C Calculate contributions to the Cartesian gradient.
2118 facvdw=-6*rrmij*(ev1+evdwij)*sss
2119 facel=-3*rrmij*(el1+eesij)
2126 * Radial derivatives. First process both termini of the fragment (i,j)
2133 gelc(k,i)=gelc(k,i)+ghalf
2134 gelc(k,j)=gelc(k,j)+ghalf
2137 * Loop over residues i+1 thru j-1.
2141 gelc(l,k)=gelc(l,k)+ggg(l)
2147 if (sss.gt.0.0) then
2148 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2149 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2150 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2158 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2159 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2162 * Loop over residues i+1 thru j-1.
2166 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2170 facvdw=(ev1+evdwij)*sss
2173 fac=-3*rrmij*(facvdw+facvdw+facel)
2179 * Radial derivatives. First process both termini of the fragment (i,j)
2186 gelc(k,i)=gelc(k,i)+ghalf
2187 gelc(k,j)=gelc(k,j)+ghalf
2190 * Loop over residues i+1 thru j-1.
2194 gelc(l,k)=gelc(l,k)+ggg(l)
2201 ecosa=2.0D0*fac3*fac1+fac4
2204 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2205 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2207 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2208 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2210 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2211 cd & (dcosg(k),k=1,3)
2213 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2217 gelc(k,i)=gelc(k,i)+ghalf
2218 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2219 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2220 gelc(k,j)=gelc(k,j)+ghalf
2221 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2222 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2226 gelc(l,k)=gelc(l,k)+ggg(l)
2231 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2232 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2233 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2235 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2236 C energy of a peptide unit is assumed in the form of a second-order
2237 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2238 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2239 C are computed for EVERY pair of non-contiguous peptide groups.
2241 if (j.lt.nres-1) then
2252 muij(kkk)=mu(k,i)*mu(l,j)
2255 cd write (iout,*) 'EELEC: i',i,' j',j
2256 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2257 cd write(iout,*) 'muij',muij
2258 ury=scalar(uy(1,i),erij)
2259 urz=scalar(uz(1,i),erij)
2260 vry=scalar(uy(1,j),erij)
2261 vrz=scalar(uz(1,j),erij)
2262 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2263 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2264 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2265 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2266 C For diagnostics only
2271 fac=dsqrt(-ael6i)*r3ij
2272 cd write (2,*) 'fac=',fac
2273 C For diagnostics only
2279 cd write (iout,'(4i5,4f10.5)')
2280 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2281 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2282 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2283 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2284 cd write (iout,'(4f10.5)')
2285 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2286 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2287 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2288 cd write (iout,'(2i3,9f10.5/)') i,j,
2289 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2291 C Derivatives of the elements of A in virtual-bond vectors
2292 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2299 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2300 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2301 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2302 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2303 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2304 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2305 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2306 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2307 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2308 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2309 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2310 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2320 C Compute radial contributions to the gradient
2342 C Add the contributions coming from er
2345 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2346 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2347 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2348 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2351 C Derivatives in DC(i)
2352 ghalf1=0.5d0*agg(k,1)
2353 ghalf2=0.5d0*agg(k,2)
2354 ghalf3=0.5d0*agg(k,3)
2355 ghalf4=0.5d0*agg(k,4)
2356 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2357 & -3.0d0*uryg(k,2)*vry)+ghalf1
2358 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2359 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2360 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2361 & -3.0d0*urzg(k,2)*vry)+ghalf3
2362 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2363 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2364 C Derivatives in DC(i+1)
2365 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2366 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2367 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2368 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2369 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2370 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2371 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2372 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2373 C Derivatives in DC(j)
2374 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2375 & -3.0d0*vryg(k,2)*ury)+ghalf1
2376 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2377 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2378 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2379 & -3.0d0*vryg(k,2)*urz)+ghalf3
2380 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2381 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2382 C Derivatives in DC(j+1) or DC(nres-1)
2383 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2384 & -3.0d0*vryg(k,3)*ury)
2385 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2386 & -3.0d0*vrzg(k,3)*ury)
2387 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2388 & -3.0d0*vryg(k,3)*urz)
2389 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2390 & -3.0d0*vrzg(k,3)*urz)
2395 C Derivatives in DC(i+1)
2396 cd aggi1(k,1)=agg(k,1)
2397 cd aggi1(k,2)=agg(k,2)
2398 cd aggi1(k,3)=agg(k,3)
2399 cd aggi1(k,4)=agg(k,4)
2400 C Derivatives in DC(j)
2405 C Derivatives in DC(j+1)
2410 if (j.eq.nres-1 .and. i.lt.j-2) then
2412 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2413 cd aggj1(k,l)=agg(k,l)
2419 C Check the loc-el terms by numerical integration
2429 aggi(k,l)=-aggi(k,l)
2430 aggi1(k,l)=-aggi1(k,l)
2431 aggj(k,l)=-aggj(k,l)
2432 aggj1(k,l)=-aggj1(k,l)
2435 if (j.lt.nres-1) then
2441 aggi(k,l)=-aggi(k,l)
2442 aggi1(k,l)=-aggi1(k,l)
2443 aggj(k,l)=-aggj(k,l)
2444 aggj1(k,l)=-aggj1(k,l)
2455 aggi(k,l)=-aggi(k,l)
2456 aggi1(k,l)=-aggi1(k,l)
2457 aggj(k,l)=-aggj(k,l)
2458 aggj1(k,l)=-aggj1(k,l)
2464 IF (wel_loc.gt.0.0d0) THEN
2465 C Contribution to the local-electrostatic energy coming from the i-j pair
2466 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2468 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2469 C write (iout,'(a6,2i5,0pf7.3)')
2470 C & 'eelloc',i,j,eel_loc_ij
2471 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2472 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2473 eel_loc=eel_loc+eel_loc_ij
2474 C Partial derivatives in virtual-bond dihedral angles gamma
2477 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2478 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2479 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2480 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2481 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2482 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2483 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2484 cd write(iout,*) 'agg ',agg
2485 cd write(iout,*) 'aggi ',aggi
2486 cd write(iout,*) 'aggi1',aggi1
2487 cd write(iout,*) 'aggj ',aggj
2488 cd write(iout,*) 'aggj1',aggj1
2490 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2492 ggg(l)=agg(l,1)*muij(1)+
2493 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2497 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2500 C Remaining derivatives of eello
2502 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2503 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2504 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2505 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2506 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2507 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2508 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2509 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2513 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2514 C Contributions from turns
2519 call eturn34(i,j,eello_turn3,eello_turn4)
2521 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2522 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2524 C Calculate the contact function. The ith column of the array JCONT will
2525 C contain the numbers of atoms that make contacts with the atom I (of numbers
2526 C greater than I). The arrays FACONT and GACONT will contain the values of
2527 C the contact function and its derivative.
2528 c r0ij=1.02D0*rpp(iteli,itelj)
2529 c r0ij=1.11D0*rpp(iteli,itelj)
2530 r0ij=2.20D0*rpp(iteli,itelj)
2531 c r0ij=1.55D0*rpp(iteli,itelj)
2532 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2533 if (fcont.gt.0.0D0) then
2534 num_conti=num_conti+1
2535 if (num_conti.gt.maxconts) then
2536 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2537 & ' will skip next contacts for this conf.'
2539 jcont_hb(num_conti,i)=j
2540 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2541 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2542 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2544 d_cont(num_conti,i)=rij
2545 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2546 C --- Electrostatic-interaction matrix ---
2547 a_chuj(1,1,num_conti,i)=a22
2548 a_chuj(1,2,num_conti,i)=a23
2549 a_chuj(2,1,num_conti,i)=a32
2550 a_chuj(2,2,num_conti,i)=a33
2551 C --- Gradient of rij
2553 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2556 c a_chuj(1,1,num_conti,i)=-0.61d0
2557 c a_chuj(1,2,num_conti,i)= 0.4d0
2558 c a_chuj(2,1,num_conti,i)= 0.65d0
2559 c a_chuj(2,2,num_conti,i)= 0.50d0
2560 c else if (i.eq.2) then
2561 c a_chuj(1,1,num_conti,i)= 0.0d0
2562 c a_chuj(1,2,num_conti,i)= 0.0d0
2563 c a_chuj(2,1,num_conti,i)= 0.0d0
2564 c a_chuj(2,2,num_conti,i)= 0.0d0
2566 C --- and its gradients
2567 cd write (iout,*) 'i',i,' j',j
2569 cd write (iout,*) 'iii 1 kkk',kkk
2570 cd write (iout,*) agg(kkk,:)
2573 cd write (iout,*) 'iii 2 kkk',kkk
2574 cd write (iout,*) aggi(kkk,:)
2577 cd write (iout,*) 'iii 3 kkk',kkk
2578 cd write (iout,*) aggi1(kkk,:)
2581 cd write (iout,*) 'iii 4 kkk',kkk
2582 cd write (iout,*) aggj(kkk,:)
2585 cd write (iout,*) 'iii 5 kkk',kkk
2586 cd write (iout,*) aggj1(kkk,:)
2593 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2594 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2595 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2596 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2597 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2599 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2605 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2606 C Calculate contact energies
2608 wij=cosa-3.0D0*cosb*cosg
2611 c fac3=dsqrt(-ael6i)/r0ij**3
2612 fac3=dsqrt(-ael6i)*r3ij
2613 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2614 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2616 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2617 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2618 C Diagnostics. Comment out or remove after debugging!
2619 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2620 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2621 c ees0m(num_conti,i)=0.0D0
2623 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2624 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2625 facont_hb(num_conti,i)=fcont
2627 C Angular derivatives of the contact function
2628 ees0pij1=fac3/ees0pij
2629 ees0mij1=fac3/ees0mij
2630 fac3p=-3.0D0*fac3*rrmij
2631 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2632 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2634 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2635 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2636 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2637 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2638 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2639 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2640 ecosap=ecosa1+ecosa2
2641 ecosbp=ecosb1+ecosb2
2642 ecosgp=ecosg1+ecosg2
2643 ecosam=ecosa1-ecosa2
2644 ecosbm=ecosb1-ecosb2
2645 ecosgm=ecosg1-ecosg2
2654 fprimcont=fprimcont/rij
2655 cd facont_hb(num_conti,i)=1.0D0
2656 C Following line is for diagnostics.
2659 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2660 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2663 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2664 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2666 gggp(1)=gggp(1)+ees0pijp*xj
2667 gggp(2)=gggp(2)+ees0pijp*yj
2668 gggp(3)=gggp(3)+ees0pijp*zj
2669 gggm(1)=gggm(1)+ees0mijp*xj
2670 gggm(2)=gggm(2)+ees0mijp*yj
2671 gggm(3)=gggm(3)+ees0mijp*zj
2672 C Derivatives due to the contact function
2673 gacont_hbr(1,num_conti,i)=fprimcont*xj
2674 gacont_hbr(2,num_conti,i)=fprimcont*yj
2675 gacont_hbr(3,num_conti,i)=fprimcont*zj
2677 ghalfp=0.5D0*gggp(k)
2678 ghalfm=0.5D0*gggm(k)
2679 gacontp_hb1(k,num_conti,i)=ghalfp
2680 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2681 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2682 gacontp_hb2(k,num_conti,i)=ghalfp
2683 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2684 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2685 gacontp_hb3(k,num_conti,i)=gggp(k)
2686 gacontm_hb1(k,num_conti,i)=ghalfm
2687 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2688 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2689 gacontm_hb2(k,num_conti,i)=ghalfm
2690 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2691 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2692 gacontm_hb3(k,num_conti,i)=gggm(k)
2695 C Diagnostics. Comment out or remove after debugging!
2697 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2698 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2699 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2700 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2701 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2702 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2705 endif ! num_conti.le.maxconts
2710 num_cont_hb(i)=num_conti
2714 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2715 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2717 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2718 ccc eel_loc=eel_loc+eello_turn3
2721 C-----------------------------------------------------------------------------
2722 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2723 C Third- and fourth-order contributions from turns
2724 implicit real*8 (a-h,o-z)
2725 include 'DIMENSIONS'
2726 include 'DIMENSIONS.ZSCOPT'
2727 include 'COMMON.IOUNITS'
2728 include 'COMMON.GEO'
2729 include 'COMMON.VAR'
2730 include 'COMMON.LOCAL'
2731 include 'COMMON.CHAIN'
2732 include 'COMMON.DERIV'
2733 include 'COMMON.INTERACT'
2734 include 'COMMON.CONTACTS'
2735 include 'COMMON.TORSION'
2736 include 'COMMON.VECTORS'
2737 include 'COMMON.FFIELD'
2739 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2740 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2741 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2742 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2743 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2744 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2746 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2748 C Third-order contributions
2755 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2756 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2757 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2758 call transpose2(auxmat(1,1),auxmat1(1,1))
2759 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2760 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2761 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2762 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2763 cd & ' eello_turn3_num',4*eello_turn3_num
2765 C Derivatives in gamma(i)
2766 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2767 call transpose2(auxmat2(1,1),pizda(1,1))
2768 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2769 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2770 C Derivatives in gamma(i+1)
2771 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2772 call transpose2(auxmat2(1,1),pizda(1,1))
2773 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2774 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2775 & +0.5d0*(pizda(1,1)+pizda(2,2))
2776 C Cartesian derivatives
2778 a_temp(1,1)=aggi(l,1)
2779 a_temp(1,2)=aggi(l,2)
2780 a_temp(2,1)=aggi(l,3)
2781 a_temp(2,2)=aggi(l,4)
2782 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2783 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2784 & +0.5d0*(pizda(1,1)+pizda(2,2))
2785 a_temp(1,1)=aggi1(l,1)
2786 a_temp(1,2)=aggi1(l,2)
2787 a_temp(2,1)=aggi1(l,3)
2788 a_temp(2,2)=aggi1(l,4)
2789 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2790 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2791 & +0.5d0*(pizda(1,1)+pizda(2,2))
2792 a_temp(1,1)=aggj(l,1)
2793 a_temp(1,2)=aggj(l,2)
2794 a_temp(2,1)=aggj(l,3)
2795 a_temp(2,2)=aggj(l,4)
2796 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2797 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2798 & +0.5d0*(pizda(1,1)+pizda(2,2))
2799 a_temp(1,1)=aggj1(l,1)
2800 a_temp(1,2)=aggj1(l,2)
2801 a_temp(2,1)=aggj1(l,3)
2802 a_temp(2,2)=aggj1(l,4)
2803 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2804 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2805 & +0.5d0*(pizda(1,1)+pizda(2,2))
2808 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2809 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2810 C changes suggested by Ana to avoid out of bounds
2811 & .or.((i+5).gt.nres)
2813 C end of changes suggested by Ana
2814 & .or. itype(i+3).eq.ntyp1
2815 & .or. itype(i+4).eq.ntyp1
2816 & .or. itype(i+5).eq.ntyp1
2817 & .or. itype(i).eq.ntyp1
2818 & .or. itype(i-1).eq.ntyp1) goto 178
2819 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2821 C Fourth-order contributions
2829 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2830 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2831 iti1=itortyp(itype(i+1))
2832 iti2=itortyp(itype(i+2))
2833 iti3=itortyp(itype(i+3))
2834 call transpose2(EUg(1,1,i+1),e1t(1,1))
2835 call transpose2(Eug(1,1,i+2),e2t(1,1))
2836 call transpose2(Eug(1,1,i+3),e3t(1,1))
2837 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2838 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2839 s1=scalar2(b1(1,iti2),auxvec(1))
2840 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2841 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2842 s2=scalar2(b1(1,iti1),auxvec(1))
2843 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2844 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2845 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2846 eello_turn4=eello_turn4-(s1+s2+s3)
2847 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2848 cd & ' eello_turn4_num',8*eello_turn4_num
2849 C Derivatives in gamma(i)
2851 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2852 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2853 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2854 s1=scalar2(b1(1,iti2),auxvec(1))
2855 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2856 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2857 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2858 C Derivatives in gamma(i+1)
2859 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2860 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2861 s2=scalar2(b1(1,iti1),auxvec(1))
2862 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2863 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2864 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2865 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2866 C Derivatives in gamma(i+2)
2867 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2868 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2869 s1=scalar2(b1(1,iti2),auxvec(1))
2870 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2871 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2872 s2=scalar2(b1(1,iti1),auxvec(1))
2873 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2874 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2875 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2876 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2877 C Cartesian derivatives
2878 C Derivatives of this turn contributions in DC(i+2)
2879 if (j.lt.nres-1) then
2881 a_temp(1,1)=agg(l,1)
2882 a_temp(1,2)=agg(l,2)
2883 a_temp(2,1)=agg(l,3)
2884 a_temp(2,2)=agg(l,4)
2885 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2886 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2887 s1=scalar2(b1(1,iti2),auxvec(1))
2888 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2889 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2890 s2=scalar2(b1(1,iti1),auxvec(1))
2891 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2892 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2893 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2895 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2898 C Remaining derivatives of this turn contribution
2900 a_temp(1,1)=aggi(l,1)
2901 a_temp(1,2)=aggi(l,2)
2902 a_temp(2,1)=aggi(l,3)
2903 a_temp(2,2)=aggi(l,4)
2904 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2905 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2906 s1=scalar2(b1(1,iti2),auxvec(1))
2907 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2908 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2909 s2=scalar2(b1(1,iti1),auxvec(1))
2910 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2911 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2912 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2913 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2914 a_temp(1,1)=aggi1(l,1)
2915 a_temp(1,2)=aggi1(l,2)
2916 a_temp(2,1)=aggi1(l,3)
2917 a_temp(2,2)=aggi1(l,4)
2918 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2919 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2920 s1=scalar2(b1(1,iti2),auxvec(1))
2921 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2922 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2923 s2=scalar2(b1(1,iti1),auxvec(1))
2924 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2925 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2926 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2927 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2928 a_temp(1,1)=aggj(l,1)
2929 a_temp(1,2)=aggj(l,2)
2930 a_temp(2,1)=aggj(l,3)
2931 a_temp(2,2)=aggj(l,4)
2932 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2933 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2934 s1=scalar2(b1(1,iti2),auxvec(1))
2935 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2936 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2937 s2=scalar2(b1(1,iti1),auxvec(1))
2938 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2939 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2940 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2941 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2942 a_temp(1,1)=aggj1(l,1)
2943 a_temp(1,2)=aggj1(l,2)
2944 a_temp(2,1)=aggj1(l,3)
2945 a_temp(2,2)=aggj1(l,4)
2946 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2947 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2948 s1=scalar2(b1(1,iti2),auxvec(1))
2949 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2950 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2951 s2=scalar2(b1(1,iti1),auxvec(1))
2952 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2953 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2954 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2955 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2962 C-----------------------------------------------------------------------------
2963 subroutine vecpr(u,v,w)
2964 implicit real*8(a-h,o-z)
2965 dimension u(3),v(3),w(3)
2966 w(1)=u(2)*v(3)-u(3)*v(2)
2967 w(2)=-u(1)*v(3)+u(3)*v(1)
2968 w(3)=u(1)*v(2)-u(2)*v(1)
2971 C-----------------------------------------------------------------------------
2972 subroutine unormderiv(u,ugrad,unorm,ungrad)
2973 C This subroutine computes the derivatives of a normalized vector u, given
2974 C the derivatives computed without normalization conditions, ugrad. Returns
2977 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2978 double precision vec(3)
2979 double precision scalar
2981 c write (2,*) 'ugrad',ugrad
2984 vec(i)=scalar(ugrad(1,i),u(1))
2986 c write (2,*) 'vec',vec
2989 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2992 c write (2,*) 'ungrad',ungrad
2995 C-----------------------------------------------------------------------------
2996 subroutine escp(evdw2,evdw2_14)
2998 C This subroutine calculates the excluded-volume interaction energy between
2999 C peptide-group centers and side chains and its gradient in virtual-bond and
3000 C side-chain vectors.
3002 implicit real*8 (a-h,o-z)
3003 include 'DIMENSIONS'
3004 include 'DIMENSIONS.ZSCOPT'
3005 include 'COMMON.GEO'
3006 include 'COMMON.VAR'
3007 include 'COMMON.LOCAL'
3008 include 'COMMON.CHAIN'
3009 include 'COMMON.DERIV'
3010 include 'COMMON.INTERACT'
3011 include 'COMMON.FFIELD'
3012 include 'COMMON.IOUNITS'
3016 cd print '(a)','Enter ESCP'
3017 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3018 c & ' scal14',scal14
3019 do i=iatscp_s,iatscp_e
3020 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3022 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3023 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3024 if (iteli.eq.0) goto 1225
3025 xi=0.5D0*(c(1,i)+c(1,i+1))
3026 yi=0.5D0*(c(2,i)+c(2,i+1))
3027 zi=0.5D0*(c(3,i)+c(3,i+1))
3028 C Returning the ith atom to box
3030 if (xi.lt.0) xi=xi+boxxsize
3032 if (yi.lt.0) yi=yi+boxysize
3034 if (zi.lt.0) zi=zi+boxzsize
3035 do iint=1,nscp_gr(i)
3037 do j=iscpstart(i,iint),iscpend(i,iint)
3038 itypj=iabs(itype(j))
3039 if (itypj.eq.ntyp1) cycle
3040 C Uncomment following three lines for SC-p interactions
3044 C Uncomment following three lines for Ca-p interactions
3048 C returning the jth atom to box
3050 if (xj.lt.0) xj=xj+boxxsize
3052 if (yj.lt.0) yj=yj+boxysize
3054 if (zj.lt.0) zj=zj+boxzsize
3055 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3060 C Finding the closest jth atom
3064 xj=xj_safe+xshift*boxxsize
3065 yj=yj_safe+yshift*boxysize
3066 zj=zj_safe+zshift*boxzsize
3067 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3068 if(dist_temp.lt.dist_init) then
3078 if (subchap.eq.1) then
3087 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3088 C sss is scaling function for smoothing the cutoff gradient otherwise
3089 C the gradient would not be continuouse
3090 sss=sscale(1.0d0/(dsqrt(rrij)))
3091 if (sss.le.0.0d0) cycle
3092 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3094 e1=fac*fac*aad(itypj,iteli)
3095 e2=fac*bad(itypj,iteli)
3096 if (iabs(j-i) .le. 2) then
3099 evdw2_14=evdw2_14+(e1+e2)*sss
3102 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3103 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3104 c & bad(itypj,iteli)
3105 evdw2=evdw2+evdwij*sss
3108 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3110 fac=-(evdwij+e1)*rrij*sss
3111 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3116 cd write (iout,*) 'j<i'
3117 C Uncomment following three lines for SC-p interactions
3119 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3122 cd write (iout,*) 'j>i'
3125 C Uncomment following line for SC-p interactions
3126 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3130 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3134 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3135 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3138 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3148 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3149 gradx_scp(j,i)=expon*gradx_scp(j,i)
3152 C******************************************************************************
3156 C To save time the factor EXPON has been extracted from ALL components
3157 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3160 C******************************************************************************
3163 C--------------------------------------------------------------------------
3164 subroutine edis(ehpb)
3166 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3168 implicit real*8 (a-h,o-z)
3169 include 'DIMENSIONS'
3170 include 'DIMENSIONS.ZSCOPT'
3171 include 'COMMON.SBRIDGE'
3172 include 'COMMON.CHAIN'
3173 include 'COMMON.DERIV'
3174 include 'COMMON.VAR'
3175 include 'COMMON.INTERACT'
3178 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3179 cd print *,'link_start=',link_start,' link_end=',link_end
3180 if (link_end.eq.0) return
3181 do i=link_start,link_end
3182 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3183 C CA-CA distance used in regularization of structure.
3186 C iii and jjj point to the residues for which the distance is assigned.
3187 if (ii.gt.nres) then
3194 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3195 C distance and angle dependent SS bond potential.
3196 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3197 & iabs(itype(jjj)).eq.1) then
3198 call ssbond_ene(iii,jjj,eij)
3201 C Calculate the distance between the two points and its difference from the
3205 C Get the force constant corresponding to this distance.
3207 C Calculate the contribution to energy.
3208 ehpb=ehpb+waga*rdis*rdis
3210 C Evaluate gradient.
3213 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3214 cd & ' waga=',waga,' fac=',fac
3216 ggg(j)=fac*(c(j,jj)-c(j,ii))
3218 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3219 C If this is a SC-SC distance, we need to calculate the contributions to the
3220 C Cartesian gradient in the SC vectors (ghpbx).
3223 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3224 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3229 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3237 C--------------------------------------------------------------------------
3238 subroutine ssbond_ene(i,j,eij)
3240 C Calculate the distance and angle dependent SS-bond potential energy
3241 C using a free-energy function derived based on RHF/6-31G** ab initio
3242 C calculations of diethyl disulfide.
3244 C A. Liwo and U. Kozlowska, 11/24/03
3246 implicit real*8 (a-h,o-z)
3247 include 'DIMENSIONS'
3248 include 'DIMENSIONS.ZSCOPT'
3249 include 'COMMON.SBRIDGE'
3250 include 'COMMON.CHAIN'
3251 include 'COMMON.DERIV'
3252 include 'COMMON.LOCAL'
3253 include 'COMMON.INTERACT'
3254 include 'COMMON.VAR'
3255 include 'COMMON.IOUNITS'
3256 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3257 itypi=iabs(itype(i))
3261 dxi=dc_norm(1,nres+i)
3262 dyi=dc_norm(2,nres+i)
3263 dzi=dc_norm(3,nres+i)
3264 dsci_inv=dsc_inv(itypi)
3265 itypj=iabs(itype(j))
3266 dscj_inv=dsc_inv(itypj)
3270 dxj=dc_norm(1,nres+j)
3271 dyj=dc_norm(2,nres+j)
3272 dzj=dc_norm(3,nres+j)
3273 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3278 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3279 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3280 om12=dxi*dxj+dyi*dyj+dzi*dzj
3282 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3283 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3289 deltat12=om2-om1+2.0d0
3291 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3292 & +akct*deltad*deltat12
3293 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3294 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3295 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3296 c & " deltat12",deltat12," eij",eij
3297 ed=2*akcm*deltad+akct*deltat12
3299 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3300 eom1=-2*akth*deltat1-pom1-om2*pom2
3301 eom2= 2*akth*deltat2+pom1-om1*pom2
3304 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3307 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3308 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3309 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3310 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3313 C Calculate the components of the gradient in DC and X
3317 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3322 C--------------------------------------------------------------------------
3323 subroutine ebond(estr)
3325 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3327 implicit real*8 (a-h,o-z)
3328 include 'DIMENSIONS'
3329 include 'DIMENSIONS.ZSCOPT'
3330 include 'COMMON.LOCAL'
3331 include 'COMMON.GEO'
3332 include 'COMMON.INTERACT'
3333 include 'COMMON.DERIV'
3334 include 'COMMON.VAR'
3335 include 'COMMON.CHAIN'
3336 include 'COMMON.IOUNITS'
3337 include 'COMMON.NAMES'
3338 include 'COMMON.FFIELD'
3339 include 'COMMON.CONTROL'
3340 logical energy_dec /.false./
3341 double precision u(3),ud(3)
3344 c write (iout,*) "distchainmax",distchainmax
3346 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3347 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3349 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3350 C & *dc(j,i-1)/vbld(i)
3352 C if (energy_dec) write(iout,*)
3353 C & "estr1",i,vbld(i),distchainmax,
3354 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3356 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3357 diff = vbld(i)-vbldpDUM
3359 diff = vbld(i)-vbldp0
3360 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3364 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3367 C write (iout,'(a7,i5,4f7.3)')
3368 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3370 estr=0.5d0*AKP*estr+estr1
3372 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3376 if (iti.ne.10 .and. iti.ne.ntyp1) then
3379 diff=vbld(i+nres)-vbldsc0(1,iti)
3380 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3381 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3382 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3384 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3388 diff=vbld(i+nres)-vbldsc0(j,iti)
3389 ud(j)=aksc(j,iti)*diff
3390 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3404 uprod2=uprod2*u(k)*u(k)
3408 usumsqder=usumsqder+ud(j)*uprod2
3410 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3411 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3412 estr=estr+uprod/usum
3414 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3422 C--------------------------------------------------------------------------
3423 subroutine ebend(etheta)
3425 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3426 C angles gamma and its derivatives in consecutive thetas and gammas.
3428 implicit real*8 (a-h,o-z)
3429 include 'DIMENSIONS'
3430 include 'DIMENSIONS.ZSCOPT'
3431 include 'COMMON.LOCAL'
3432 include 'COMMON.GEO'
3433 include 'COMMON.INTERACT'
3434 include 'COMMON.DERIV'
3435 include 'COMMON.VAR'
3436 include 'COMMON.CHAIN'
3437 include 'COMMON.IOUNITS'
3438 include 'COMMON.NAMES'
3439 include 'COMMON.FFIELD'
3440 common /calcthet/ term1,term2,termm,diffak,ratak,
3441 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3442 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3443 double precision y(2),z(2)
3445 time11=dexp(-2*time)
3448 c write (iout,*) "nres",nres
3449 c write (*,'(a,i2)') 'EBEND ICG=',icg
3450 c write (iout,*) ithet_start,ithet_end
3451 do i=ithet_start,ithet_end
3452 C if (itype(i-1).eq.ntyp1) cycle
3454 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3455 & .or.itype(i).eq.ntyp1) cycle
3456 C Zero the energy function and its derivative at 0 or pi.
3457 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3459 ichir1=isign(1,itype(i-2))
3460 ichir2=isign(1,itype(i))
3461 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3462 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3463 if (itype(i-1).eq.10) then
3464 itype1=isign(10,itype(i-2))
3465 ichir11=isign(1,itype(i-2))
3466 ichir12=isign(1,itype(i-2))
3467 itype2=isign(10,itype(i))
3468 ichir21=isign(1,itype(i))
3469 ichir22=isign(1,itype(i))
3476 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3480 call proc_proc(phii,icrc)
3481 if (icrc.eq.1) phii=150.0
3492 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3496 call proc_proc(phii1,icrc)
3497 if (icrc.eq.1) phii1=150.0
3509 C Calculate the "mean" value of theta from the part of the distribution
3510 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3511 C In following comments this theta will be referred to as t_c.
3512 thet_pred_mean=0.0d0
3514 athetk=athet(k,it,ichir1,ichir2)
3515 bthetk=bthet(k,it,ichir1,ichir2)
3517 athetk=athet(k,itype1,ichir11,ichir12)
3518 bthetk=bthet(k,itype2,ichir21,ichir22)
3520 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3522 c write (iout,*) "thet_pred_mean",thet_pred_mean
3523 dthett=thet_pred_mean*ssd
3524 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3525 c write (iout,*) "thet_pred_mean",thet_pred_mean
3526 C Derivatives of the "mean" values in gamma1 and gamma2.
3527 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3528 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3529 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3530 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3532 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3533 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3534 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3535 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3537 if (theta(i).gt.pi-delta) then
3538 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3540 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3541 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3542 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3544 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3546 else if (theta(i).lt.delta) then
3547 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3548 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3549 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3551 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3552 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3555 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3558 etheta=etheta+ethetai
3559 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
3560 c & 'ebend',i,ethetai,theta(i),itype(i)
3561 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3562 c & rad2deg*phii,rad2deg*phii1,ethetai
3563 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3564 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3565 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3568 C Ufff.... We've done all this!!!
3571 C---------------------------------------------------------------------------
3572 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3574 implicit real*8 (a-h,o-z)
3575 include 'DIMENSIONS'
3576 include 'COMMON.LOCAL'
3577 include 'COMMON.IOUNITS'
3578 common /calcthet/ term1,term2,termm,diffak,ratak,
3579 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3580 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3581 C Calculate the contributions to both Gaussian lobes.
3582 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3583 C The "polynomial part" of the "standard deviation" of this part of
3587 sig=sig*thet_pred_mean+polthet(j,it)
3589 C Derivative of the "interior part" of the "standard deviation of the"
3590 C gamma-dependent Gaussian lobe in t_c.
3591 sigtc=3*polthet(3,it)
3593 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3596 C Set the parameters of both Gaussian lobes of the distribution.
3597 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3598 fac=sig*sig+sigc0(it)
3601 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3602 sigsqtc=-4.0D0*sigcsq*sigtc
3603 c print *,i,sig,sigtc,sigsqtc
3604 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3605 sigtc=-sigtc/(fac*fac)
3606 C Following variable is sigma(t_c)**(-2)
3607 sigcsq=sigcsq*sigcsq
3609 sig0inv=1.0D0/sig0i**2
3610 delthec=thetai-thet_pred_mean
3611 delthe0=thetai-theta0i
3612 term1=-0.5D0*sigcsq*delthec*delthec
3613 term2=-0.5D0*sig0inv*delthe0*delthe0
3614 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3615 C NaNs in taking the logarithm. We extract the largest exponent which is added
3616 C to the energy (this being the log of the distribution) at the end of energy
3617 C term evaluation for this virtual-bond angle.
3618 if (term1.gt.term2) then
3620 term2=dexp(term2-termm)
3624 term1=dexp(term1-termm)
3627 C The ratio between the gamma-independent and gamma-dependent lobes of
3628 C the distribution is a Gaussian function of thet_pred_mean too.
3629 diffak=gthet(2,it)-thet_pred_mean
3630 ratak=diffak/gthet(3,it)**2
3631 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3632 C Let's differentiate it in thet_pred_mean NOW.
3634 C Now put together the distribution terms to make complete distribution.
3635 termexp=term1+ak*term2
3636 termpre=sigc+ak*sig0i
3637 C Contribution of the bending energy from this theta is just the -log of
3638 C the sum of the contributions from the two lobes and the pre-exponential
3639 C factor. Simple enough, isn't it?
3640 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3641 C NOW the derivatives!!!
3642 C 6/6/97 Take into account the deformation.
3643 E_theta=(delthec*sigcsq*term1
3644 & +ak*delthe0*sig0inv*term2)/termexp
3645 E_tc=((sigtc+aktc*sig0i)/termpre
3646 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3647 & aktc*term2)/termexp)
3650 c-----------------------------------------------------------------------------
3651 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3652 implicit real*8 (a-h,o-z)
3653 include 'DIMENSIONS'
3654 include 'COMMON.LOCAL'
3655 include 'COMMON.IOUNITS'
3656 common /calcthet/ term1,term2,termm,diffak,ratak,
3657 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3658 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3659 delthec=thetai-thet_pred_mean
3660 delthe0=thetai-theta0i
3661 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3662 t3 = thetai-thet_pred_mean
3666 t14 = t12+t6*sigsqtc
3668 t21 = thetai-theta0i
3674 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3675 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3676 & *(-t12*t9-ak*sig0inv*t27)
3680 C--------------------------------------------------------------------------
3681 subroutine ebend(etheta)
3683 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3684 C angles gamma and its derivatives in consecutive thetas and gammas.
3685 C ab initio-derived potentials from
3686 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3688 implicit real*8 (a-h,o-z)
3689 include 'DIMENSIONS'
3690 include 'DIMENSIONS.ZSCOPT'
3691 include 'COMMON.LOCAL'
3692 include 'COMMON.GEO'
3693 include 'COMMON.INTERACT'
3694 include 'COMMON.DERIV'
3695 include 'COMMON.VAR'
3696 include 'COMMON.CHAIN'
3697 include 'COMMON.IOUNITS'
3698 include 'COMMON.NAMES'
3699 include 'COMMON.FFIELD'
3700 include 'COMMON.CONTROL'
3701 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3702 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3703 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3704 & sinph1ph2(maxdouble,maxdouble)
3705 logical lprn /.false./, lprn1 /.false./
3707 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3708 do i=ithet_start,ithet_end
3710 C if (itype(i-1).eq.ntyp1) cycle
3712 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3713 & .or.itype(i).eq.ntyp1) cycle
3714 if (iabs(itype(i+1)).eq.20) iblock=2
3715 if (iabs(itype(i+1)).ne.20) iblock=1
3719 theti2=0.5d0*theta(i)
3720 ityp2=ithetyp((itype(i-1)))
3722 coskt(k)=dcos(k*theti2)
3723 sinkt(k)=dsin(k*theti2)
3733 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3736 if (phii.ne.phii) phii=150.0
3740 ityp1=ithetyp((itype(i-2)))
3742 cosph1(k)=dcos(k*phii)
3743 sinph1(k)=dsin(k*phii)
3754 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3757 if (phii1.ne.phii1) phii1=150.0
3762 ityp3=ithetyp((itype(i)))
3764 cosph2(k)=dcos(k*phii1)
3765 sinph2(k)=dsin(k*phii1)
3775 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3776 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3778 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3781 ccl=cosph1(l)*cosph2(k-l)
3782 ssl=sinph1(l)*sinph2(k-l)
3783 scl=sinph1(l)*cosph2(k-l)
3784 csl=cosph1(l)*sinph2(k-l)
3785 cosph1ph2(l,k)=ccl-ssl
3786 cosph1ph2(k,l)=ccl+ssl
3787 sinph1ph2(l,k)=scl+csl
3788 sinph1ph2(k,l)=scl-csl
3792 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3793 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3794 write (iout,*) "coskt and sinkt"
3796 write (iout,*) k,coskt(k),sinkt(k)
3800 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3801 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3804 & write (iout,*) "k",k,"
3805 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3806 & " ethetai",ethetai
3809 write (iout,*) "cosph and sinph"
3811 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3813 write (iout,*) "cosph1ph2 and sinph2ph2"
3816 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3817 & sinph1ph2(l,k),sinph1ph2(k,l)
3820 write(iout,*) "ethetai",ethetai
3824 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3825 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3826 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3827 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3828 ethetai=ethetai+sinkt(m)*aux
3829 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3830 dephii=dephii+k*sinkt(m)*(
3831 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3832 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3833 dephii1=dephii1+k*sinkt(m)*(
3834 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3835 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3837 & write (iout,*) "m",m," k",k," bbthet",
3838 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3839 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3840 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3841 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3845 & write(iout,*) "ethetai",ethetai
3849 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3850 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3851 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3852 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3853 ethetai=ethetai+sinkt(m)*aux
3854 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3855 dephii=dephii+l*sinkt(m)*(
3856 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3857 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3858 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3859 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3860 dephii1=dephii1+(k-l)*sinkt(m)*(
3861 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3862 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3863 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3864 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3866 write (iout,*) "m",m," k",k," l",l," ffthet",
3867 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3868 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3869 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3870 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3871 & " ethetai",ethetai
3872 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3873 & cosph1ph2(k,l)*sinkt(m),
3874 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3880 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3881 & i,theta(i)*rad2deg,phii*rad2deg,
3882 & phii1*rad2deg,ethetai
3883 etheta=etheta+ethetai
3884 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3885 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3886 gloc(nphi+i-2,icg)=wang*dethetai
3892 c-----------------------------------------------------------------------------
3893 subroutine esc(escloc)
3894 C Calculate the local energy of a side chain and its derivatives in the
3895 C corresponding virtual-bond valence angles THETA and the spherical angles
3897 implicit real*8 (a-h,o-z)
3898 include 'DIMENSIONS'
3899 include 'DIMENSIONS.ZSCOPT'
3900 include 'COMMON.GEO'
3901 include 'COMMON.LOCAL'
3902 include 'COMMON.VAR'
3903 include 'COMMON.INTERACT'
3904 include 'COMMON.DERIV'
3905 include 'COMMON.CHAIN'
3906 include 'COMMON.IOUNITS'
3907 include 'COMMON.NAMES'
3908 include 'COMMON.FFIELD'
3909 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3910 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3911 common /sccalc/ time11,time12,time112,theti,it,nlobit
3914 C write (iout,*) 'ESC'
3915 do i=loc_start,loc_end
3917 if (it.eq.ntyp1) cycle
3918 if (it.eq.10) goto 1
3919 nlobit=nlob(iabs(it))
3920 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3921 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3922 theti=theta(i+1)-pipol
3926 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3928 if (x(2).gt.pi-delta) then
3932 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3934 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3935 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3937 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3938 & ddersc0(1),dersc(1))
3939 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3940 & ddersc0(3),dersc(3))
3942 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3944 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3945 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3946 & dersc0(2),esclocbi,dersc02)
3947 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3949 call splinthet(x(2),0.5d0*delta,ss,ssd)
3954 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3956 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3957 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3959 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3961 c write (iout,*) escloci
3962 else if (x(2).lt.delta) then
3966 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3968 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3969 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3971 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3972 & ddersc0(1),dersc(1))
3973 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3974 & ddersc0(3),dersc(3))
3976 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3978 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3979 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3980 & dersc0(2),esclocbi,dersc02)
3981 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3986 call splinthet(x(2),0.5d0*delta,ss,ssd)
3988 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3990 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3991 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3993 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3994 C write (iout,*) 'i=',i, escloci
3996 call enesc(x,escloci,dersc,ddummy,.false.)
3999 escloc=escloc+escloci
4000 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4001 write (iout,'(a6,i5,0pf7.3)')
4002 & 'escloc',i,escloci
4004 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4006 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4007 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4012 C---------------------------------------------------------------------------
4013 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4014 implicit real*8 (a-h,o-z)
4015 include 'DIMENSIONS'
4016 include 'COMMON.GEO'
4017 include 'COMMON.LOCAL'
4018 include 'COMMON.IOUNITS'
4019 common /sccalc/ time11,time12,time112,theti,it,nlobit
4020 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4021 double precision contr(maxlob,-1:1)
4023 c write (iout,*) 'it=',it,' nlobit=',nlobit
4027 if (mixed) ddersc(j)=0.0d0
4031 C Because of periodicity of the dependence of the SC energy in omega we have
4032 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4033 C To avoid underflows, first compute & store the exponents.
4041 z(k)=x(k)-censc(k,j,it)
4046 Axk=Axk+gaussc(l,k,j,it)*z(l)
4052 expfac=expfac+Ax(k,j,iii)*z(k)
4060 C As in the case of ebend, we want to avoid underflows in exponentiation and
4061 C subsequent NaNs and INFs in energy calculation.
4062 C Find the largest exponent
4066 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4070 cd print *,'it=',it,' emin=',emin
4072 C Compute the contribution to SC energy and derivatives
4076 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4077 cd print *,'j=',j,' expfac=',expfac
4078 escloc_i=escloc_i+expfac
4080 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4084 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4085 & +gaussc(k,2,j,it))*expfac
4092 dersc(1)=dersc(1)/cos(theti)**2
4093 ddersc(1)=ddersc(1)/cos(theti)**2
4096 escloci=-(dlog(escloc_i)-emin)
4098 dersc(j)=dersc(j)/escloc_i
4102 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4107 C------------------------------------------------------------------------------
4108 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4109 implicit real*8 (a-h,o-z)
4110 include 'DIMENSIONS'
4111 include 'COMMON.GEO'
4112 include 'COMMON.LOCAL'
4113 include 'COMMON.IOUNITS'
4114 common /sccalc/ time11,time12,time112,theti,it,nlobit
4115 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4116 double precision contr(maxlob)
4127 z(k)=x(k)-censc(k,j,it)
4133 Axk=Axk+gaussc(l,k,j,it)*z(l)
4139 expfac=expfac+Ax(k,j)*z(k)
4144 C As in the case of ebend, we want to avoid underflows in exponentiation and
4145 C subsequent NaNs and INFs in energy calculation.
4146 C Find the largest exponent
4149 if (emin.gt.contr(j)) emin=contr(j)
4153 C Compute the contribution to SC energy and derivatives
4157 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4158 escloc_i=escloc_i+expfac
4160 dersc(k)=dersc(k)+Ax(k,j)*expfac
4162 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4163 & +gaussc(1,2,j,it))*expfac
4167 dersc(1)=dersc(1)/cos(theti)**2
4168 dersc12=dersc12/cos(theti)**2
4169 escloci=-(dlog(escloc_i)-emin)
4171 dersc(j)=dersc(j)/escloc_i
4173 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4177 c----------------------------------------------------------------------------------
4178 subroutine esc(escloc)
4179 C Calculate the local energy of a side chain and its derivatives in the
4180 C corresponding virtual-bond valence angles THETA and the spherical angles
4181 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4182 C added by Urszula Kozlowska. 07/11/2007
4184 implicit real*8 (a-h,o-z)
4185 include 'DIMENSIONS'
4186 include 'DIMENSIONS.ZSCOPT'
4187 include 'COMMON.GEO'
4188 include 'COMMON.LOCAL'
4189 include 'COMMON.VAR'
4190 include 'COMMON.SCROT'
4191 include 'COMMON.INTERACT'
4192 include 'COMMON.DERIV'
4193 include 'COMMON.CHAIN'
4194 include 'COMMON.IOUNITS'
4195 include 'COMMON.NAMES'
4196 include 'COMMON.FFIELD'
4197 include 'COMMON.CONTROL'
4198 include 'COMMON.VECTORS'
4199 double precision x_prime(3),y_prime(3),z_prime(3)
4200 & , sumene,dsc_i,dp2_i,x(65),
4201 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4202 & de_dxx,de_dyy,de_dzz,de_dt
4203 double precision s1_t,s1_6_t,s2_t,s2_6_t
4205 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4206 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4207 & dt_dCi(3),dt_dCi1(3)
4208 common /sccalc/ time11,time12,time112,theti,it,nlobit
4211 do i=loc_start,loc_end
4212 if (itype(i).eq.ntyp1) cycle
4213 costtab(i+1) =dcos(theta(i+1))
4214 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4215 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4216 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4217 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4218 cosfac=dsqrt(cosfac2)
4219 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4220 sinfac=dsqrt(sinfac2)
4222 if (it.eq.10) goto 1
4224 C Compute the axes of tghe local cartesian coordinates system; store in
4225 c x_prime, y_prime and z_prime
4232 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4233 C & dc_norm(3,i+nres)
4235 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4236 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4239 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4242 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4243 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4244 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4245 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4246 c & " xy",scalar(x_prime(1),y_prime(1)),
4247 c & " xz",scalar(x_prime(1),z_prime(1)),
4248 c & " yy",scalar(y_prime(1),y_prime(1)),
4249 c & " yz",scalar(y_prime(1),z_prime(1)),
4250 c & " zz",scalar(z_prime(1),z_prime(1))
4252 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4253 C to local coordinate system. Store in xx, yy, zz.
4259 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4260 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4261 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4268 C Compute the energy of the ith side cbain
4270 c write (2,*) "xx",xx," yy",yy," zz",zz
4273 x(j) = sc_parmin(j,it)
4276 Cc diagnostics - remove later
4278 yy1 = dsin(alph(2))*dcos(omeg(2))
4279 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4280 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4281 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4283 C," --- ", xx_w,yy_w,zz_w
4286 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4287 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4289 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4290 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4292 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4293 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4294 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4295 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4296 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4298 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4299 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4300 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4301 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4302 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4304 dsc_i = 0.743d0+x(61)
4306 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4307 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4308 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4309 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4310 s1=(1+x(63))/(0.1d0 + dscp1)
4311 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4312 s2=(1+x(65))/(0.1d0 + dscp2)
4313 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4314 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4315 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4316 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4318 c & dscp1,dscp2,sumene
4319 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4320 escloc = escloc + sumene
4321 c write (2,*) "escloc",escloc
4322 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4324 if (.not. calc_grad) goto 1
4327 C This section to check the numerical derivatives of the energy of ith side
4328 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4329 C #define DEBUG in the code to turn it on.
4331 write (2,*) "sumene =",sumene
4335 write (2,*) xx,yy,zz
4336 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4337 de_dxx_num=(sumenep-sumene)/aincr
4339 write (2,*) "xx+ sumene from enesc=",sumenep
4342 write (2,*) xx,yy,zz
4343 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4344 de_dyy_num=(sumenep-sumene)/aincr
4346 write (2,*) "yy+ sumene from enesc=",sumenep
4349 write (2,*) xx,yy,zz
4350 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4351 de_dzz_num=(sumenep-sumene)/aincr
4353 write (2,*) "zz+ sumene from enesc=",sumenep
4354 costsave=cost2tab(i+1)
4355 sintsave=sint2tab(i+1)
4356 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4357 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4358 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4359 de_dt_num=(sumenep-sumene)/aincr
4360 write (2,*) " t+ sumene from enesc=",sumenep
4361 cost2tab(i+1)=costsave
4362 sint2tab(i+1)=sintsave
4363 C End of diagnostics section.
4366 C Compute the gradient of esc
4368 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4369 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4370 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4371 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4372 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4373 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4374 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4375 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4376 pom1=(sumene3*sint2tab(i+1)+sumene1)
4377 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4378 pom2=(sumene4*cost2tab(i+1)+sumene2)
4379 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4380 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4381 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4382 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4384 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4385 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4386 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4388 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4389 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4390 & +(pom1+pom2)*pom_dx
4392 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4395 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4396 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4397 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4399 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4400 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4401 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4402 & +x(59)*zz**2 +x(60)*xx*zz
4403 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4404 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4405 & +(pom1-pom2)*pom_dy
4407 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4410 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4411 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4412 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4413 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4414 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4415 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4416 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4417 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4419 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4422 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4423 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4424 & +pom1*pom_dt1+pom2*pom_dt2
4426 write(2,*), "de_dt = ", de_dt,de_dt_num
4430 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4431 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4432 cosfac2xx=cosfac2*xx
4433 sinfac2yy=sinfac2*yy
4435 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4437 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4439 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4440 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4441 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4442 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4443 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4444 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4445 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4446 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4447 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4448 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4452 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4453 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4454 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4455 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4458 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4459 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4460 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4462 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4463 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4467 dXX_Ctab(k,i)=dXX_Ci(k)
4468 dXX_C1tab(k,i)=dXX_Ci1(k)
4469 dYY_Ctab(k,i)=dYY_Ci(k)
4470 dYY_C1tab(k,i)=dYY_Ci1(k)
4471 dZZ_Ctab(k,i)=dZZ_Ci(k)
4472 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4473 dXX_XYZtab(k,i)=dXX_XYZ(k)
4474 dYY_XYZtab(k,i)=dYY_XYZ(k)
4475 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4479 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4480 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4481 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4482 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4483 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4485 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4486 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4487 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4488 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4489 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4490 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4491 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4492 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4494 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4495 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4497 C to check gradient call subroutine check_grad
4504 c------------------------------------------------------------------------------
4505 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4507 C This procedure calculates two-body contact function g(rij) and its derivative:
4510 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4513 C where x=(rij-r0ij)/delta
4515 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4518 double precision rij,r0ij,eps0ij,fcont,fprimcont
4519 double precision x,x2,x4,delta
4523 if (x.lt.-1.0D0) then
4526 else if (x.le.1.0D0) then
4529 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4530 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4537 c------------------------------------------------------------------------------
4538 subroutine splinthet(theti,delta,ss,ssder)
4539 implicit real*8 (a-h,o-z)
4540 include 'DIMENSIONS'
4541 include 'DIMENSIONS.ZSCOPT'
4542 include 'COMMON.VAR'
4543 include 'COMMON.GEO'
4546 if (theti.gt.pipol) then
4547 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4549 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4554 c------------------------------------------------------------------------------
4555 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4557 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4558 double precision ksi,ksi2,ksi3,a1,a2,a3
4559 a1=fprim0*delta/(f1-f0)
4565 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4566 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4569 c------------------------------------------------------------------------------
4570 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4572 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4573 double precision ksi,ksi2,ksi3,a1,a2,a3
4578 a2=3*(f1x-f0x)-2*fprim0x*delta
4579 a3=fprim0x*delta-2*(f1x-f0x)
4580 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4583 C-----------------------------------------------------------------------------
4585 C-----------------------------------------------------------------------------
4586 subroutine etor(etors,edihcnstr,fact)
4587 implicit real*8 (a-h,o-z)
4588 include 'DIMENSIONS'
4589 include 'DIMENSIONS.ZSCOPT'
4590 include 'COMMON.VAR'
4591 include 'COMMON.GEO'
4592 include 'COMMON.LOCAL'
4593 include 'COMMON.TORSION'
4594 include 'COMMON.INTERACT'
4595 include 'COMMON.DERIV'
4596 include 'COMMON.CHAIN'
4597 include 'COMMON.NAMES'
4598 include 'COMMON.IOUNITS'
4599 include 'COMMON.FFIELD'
4600 include 'COMMON.TORCNSTR'
4602 C Set lprn=.true. for debugging
4606 do i=iphi_start,iphi_end
4607 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4608 & .or. itype(i).eq.ntyp1) cycle
4609 itori=itortyp(itype(i-2))
4610 itori1=itortyp(itype(i-1))
4613 C Proline-Proline pair is a special case...
4614 if (itori.eq.3 .and. itori1.eq.3) then
4615 if (phii.gt.-dwapi3) then
4617 fac=1.0D0/(1.0D0-cosphi)
4618 etorsi=v1(1,3,3)*fac
4619 etorsi=etorsi+etorsi
4620 etors=etors+etorsi-v1(1,3,3)
4621 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4624 v1ij=v1(j+1,itori,itori1)
4625 v2ij=v2(j+1,itori,itori1)
4628 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4629 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4633 v1ij=v1(j,itori,itori1)
4634 v2ij=v2(j,itori,itori1)
4637 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4638 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4642 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4643 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4644 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4645 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4646 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4648 ! 6/20/98 - dihedral angle constraints
4651 itori=idih_constr(i)
4654 if (difi.gt.drange(i)) then
4656 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4657 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4658 else if (difi.lt.-drange(i)) then
4660 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4661 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4663 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4664 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4666 ! write (iout,*) 'edihcnstr',edihcnstr
4669 c------------------------------------------------------------------------------
4671 subroutine etor(etors,edihcnstr,fact)
4672 implicit real*8 (a-h,o-z)
4673 include 'DIMENSIONS'
4674 include 'DIMENSIONS.ZSCOPT'
4675 include 'COMMON.VAR'
4676 include 'COMMON.GEO'
4677 include 'COMMON.LOCAL'
4678 include 'COMMON.TORSION'
4679 include 'COMMON.INTERACT'
4680 include 'COMMON.DERIV'
4681 include 'COMMON.CHAIN'
4682 include 'COMMON.NAMES'
4683 include 'COMMON.IOUNITS'
4684 include 'COMMON.FFIELD'
4685 include 'COMMON.TORCNSTR'
4687 C Set lprn=.true. for debugging
4691 do i=iphi_start,iphi_end
4693 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4694 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4695 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4696 C & .or. itype(i).eq.ntyp1) cycle
4697 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4698 if (iabs(itype(i)).eq.20) then
4703 itori=itortyp(itype(i-2))
4704 itori1=itortyp(itype(i-1))
4707 C Regular cosine and sine terms
4708 do j=1,nterm(itori,itori1,iblock)
4709 v1ij=v1(j,itori,itori1,iblock)
4710 v2ij=v2(j,itori,itori1,iblock)
4713 etors=etors+v1ij*cosphi+v2ij*sinphi
4714 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4718 C E = SUM ----------------------------------- - v1
4719 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4721 cosphi=dcos(0.5d0*phii)
4722 sinphi=dsin(0.5d0*phii)
4723 do j=1,nlor(itori,itori1,iblock)
4724 vl1ij=vlor1(j,itori,itori1)
4725 vl2ij=vlor2(j,itori,itori1)
4726 vl3ij=vlor3(j,itori,itori1)
4727 pom=vl2ij*cosphi+vl3ij*sinphi
4728 pom1=1.0d0/(pom*pom+1.0d0)
4729 etors=etors+vl1ij*pom1
4730 c if (energy_dec) etors_ii=etors_ii+
4733 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4735 C Subtract the constant term
4736 etors=etors-v0(itori,itori1,iblock)
4738 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4739 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4740 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4741 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4742 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4745 ! 6/20/98 - dihedral angle constraints
4748 itori=idih_constr(i)
4750 difi=pinorm(phii-phi0(i))
4752 if (difi.gt.drange(i)) then
4754 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4755 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4756 edihi=0.25d0*ftors*difi**4
4757 else if (difi.lt.-drange(i)) then
4759 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4760 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4761 edihi=0.25d0*ftors*difi**4
4765 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4767 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4768 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4770 ! write (iout,*) 'edihcnstr',edihcnstr
4773 c----------------------------------------------------------------------------
4774 subroutine etor_d(etors_d,fact2)
4775 C 6/23/01 Compute double torsional energy
4776 implicit real*8 (a-h,o-z)
4777 include 'DIMENSIONS'
4778 include 'DIMENSIONS.ZSCOPT'
4779 include 'COMMON.VAR'
4780 include 'COMMON.GEO'
4781 include 'COMMON.LOCAL'
4782 include 'COMMON.TORSION'
4783 include 'COMMON.INTERACT'
4784 include 'COMMON.DERIV'
4785 include 'COMMON.CHAIN'
4786 include 'COMMON.NAMES'
4787 include 'COMMON.IOUNITS'
4788 include 'COMMON.FFIELD'
4789 include 'COMMON.TORCNSTR'
4791 C Set lprn=.true. for debugging
4795 do i=iphi_start,iphi_end-1
4797 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4798 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4799 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4800 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4801 & (itype(i+1).eq.ntyp1)) cycle
4802 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4804 itori=itortyp(itype(i-2))
4805 itori1=itortyp(itype(i-1))
4806 itori2=itortyp(itype(i))
4812 if (iabs(itype(i+1)).eq.20) iblock=2
4813 C Regular cosine and sine terms
4814 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4815 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4816 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4817 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4818 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4819 cosphi1=dcos(j*phii)
4820 sinphi1=dsin(j*phii)
4821 cosphi2=dcos(j*phii1)
4822 sinphi2=dsin(j*phii1)
4823 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4824 & v2cij*cosphi2+v2sij*sinphi2
4825 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4826 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4828 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4830 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4831 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4832 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4833 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4834 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4835 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4836 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4837 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4838 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4839 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4840 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4841 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4842 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4843 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4846 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4847 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4853 c------------------------------------------------------------------------------
4854 subroutine eback_sc_corr(esccor)
4855 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4856 c conformational states; temporarily implemented as differences
4857 c between UNRES torsional potentials (dependent on three types of
4858 c residues) and the torsional potentials dependent on all 20 types
4859 c of residues computed from AM1 energy surfaces of terminally-blocked
4860 c amino-acid residues.
4861 implicit real*8 (a-h,o-z)
4862 include 'DIMENSIONS'
4863 include 'DIMENSIONS.ZSCOPT'
4864 include 'COMMON.VAR'
4865 include 'COMMON.GEO'
4866 include 'COMMON.LOCAL'
4867 include 'COMMON.TORSION'
4868 include 'COMMON.SCCOR'
4869 include 'COMMON.INTERACT'
4870 include 'COMMON.DERIV'
4871 include 'COMMON.CHAIN'
4872 include 'COMMON.NAMES'
4873 include 'COMMON.IOUNITS'
4874 include 'COMMON.FFIELD'
4875 include 'COMMON.CONTROL'
4877 C Set lprn=.true. for debugging
4880 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4882 do i=itau_start,itau_end
4883 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4885 isccori=isccortyp(itype(i-2))
4886 isccori1=isccortyp(itype(i-1))
4888 do intertyp=1,3 !intertyp
4889 cc Added 09 May 2012 (Adasko)
4890 cc Intertyp means interaction type of backbone mainchain correlation:
4891 c 1 = SC...Ca...Ca...Ca
4892 c 2 = Ca...Ca...Ca...SC
4893 c 3 = SC...Ca...Ca...SCi
4895 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4896 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4897 & (itype(i-1).eq.ntyp1)))
4898 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4899 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4900 & .or.(itype(i).eq.ntyp1)))
4901 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4902 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4903 & (itype(i-3).eq.ntyp1)))) cycle
4904 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4905 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4907 do j=1,nterm_sccor(isccori,isccori1)
4908 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4909 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4910 cosphi=dcos(j*tauangle(intertyp,i))
4911 sinphi=dsin(j*tauangle(intertyp,i))
4912 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4913 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4915 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4916 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4917 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4919 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4920 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4921 & (v1sccor(j,1,itori,itori1),j=1,6)
4922 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4923 c gsccor_loc(i-3)=gloci
4928 c------------------------------------------------------------------------------
4929 subroutine multibody(ecorr)
4930 C This subroutine calculates multi-body contributions to energy following
4931 C the idea of Skolnick et al. If side chains I and J make a contact and
4932 C at the same time side chains I+1 and J+1 make a contact, an extra
4933 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4934 implicit real*8 (a-h,o-z)
4935 include 'DIMENSIONS'
4936 include 'COMMON.IOUNITS'
4937 include 'COMMON.DERIV'
4938 include 'COMMON.INTERACT'
4939 include 'COMMON.CONTACTS'
4940 double precision gx(3),gx1(3)
4943 C Set lprn=.true. for debugging
4947 write (iout,'(a)') 'Contact function values:'
4949 write (iout,'(i2,20(1x,i2,f10.5))')
4950 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4965 num_conti=num_cont(i)
4966 num_conti1=num_cont(i1)
4971 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4972 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4973 cd & ' ishift=',ishift
4974 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4975 C The system gains extra energy.
4976 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4977 endif ! j1==j+-ishift
4986 c------------------------------------------------------------------------------
4987 double precision function esccorr(i,j,k,l,jj,kk)
4988 implicit real*8 (a-h,o-z)
4989 include 'DIMENSIONS'
4990 include 'COMMON.IOUNITS'
4991 include 'COMMON.DERIV'
4992 include 'COMMON.INTERACT'
4993 include 'COMMON.CONTACTS'
4994 double precision gx(3),gx1(3)
4999 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5000 C Calculate the multi-body contribution to energy.
5001 C Calculate multi-body contributions to the gradient.
5002 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5003 cd & k,l,(gacont(m,kk,k),m=1,3)
5005 gx(m) =ekl*gacont(m,jj,i)
5006 gx1(m)=eij*gacont(m,kk,k)
5007 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5008 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5009 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5010 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5014 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5019 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5025 c------------------------------------------------------------------------------
5027 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5028 implicit real*8 (a-h,o-z)
5029 include 'DIMENSIONS'
5030 integer dimen1,dimen2,atom,indx
5031 double precision buffer(dimen1,dimen2)
5032 double precision zapas
5033 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5034 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5035 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5036 num_kont=num_cont_hb(atom)
5040 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5043 buffer(i,indx+22)=facont_hb(i,atom)
5044 buffer(i,indx+23)=ees0p(i,atom)
5045 buffer(i,indx+24)=ees0m(i,atom)
5046 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5048 buffer(1,indx+26)=dfloat(num_kont)
5051 c------------------------------------------------------------------------------
5052 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5053 implicit real*8 (a-h,o-z)
5054 include 'DIMENSIONS'
5055 integer dimen1,dimen2,atom,indx
5056 double precision buffer(dimen1,dimen2)
5057 double precision zapas
5058 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5059 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5060 & ees0m(ntyp,maxres),
5061 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5062 num_kont=buffer(1,indx+26)
5063 num_kont_old=num_cont_hb(atom)
5064 num_cont_hb(atom)=num_kont+num_kont_old
5069 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5072 facont_hb(ii,atom)=buffer(i,indx+22)
5073 ees0p(ii,atom)=buffer(i,indx+23)
5074 ees0m(ii,atom)=buffer(i,indx+24)
5075 jcont_hb(ii,atom)=buffer(i,indx+25)
5079 c------------------------------------------------------------------------------
5081 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5082 C This subroutine calculates multi-body contributions to hydrogen-bonding
5083 implicit real*8 (a-h,o-z)
5084 include 'DIMENSIONS'
5085 include 'DIMENSIONS.ZSCOPT'
5086 include 'COMMON.IOUNITS'
5088 include 'COMMON.INFO'
5090 include 'COMMON.FFIELD'
5091 include 'COMMON.DERIV'
5092 include 'COMMON.INTERACT'
5093 include 'COMMON.CONTACTS'
5095 parameter (max_cont=maxconts)
5096 parameter (max_dim=2*(8*3+2))
5097 parameter (msglen1=max_cont*max_dim*4)
5098 parameter (msglen2=2*msglen1)
5099 integer source,CorrelType,CorrelID,Error
5100 double precision buffer(max_cont,max_dim)
5102 double precision gx(3),gx1(3)
5105 C Set lprn=.true. for debugging
5110 if (fgProcs.le.1) goto 30
5112 write (iout,'(a)') 'Contact function values:'
5114 write (iout,'(2i3,50(1x,i2,f5.2))')
5115 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5116 & j=1,num_cont_hb(i))
5119 C Caution! Following code assumes that electrostatic interactions concerning
5120 C a given atom are split among at most two processors!
5130 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5133 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5134 if (MyRank.gt.0) then
5135 C Send correlation contributions to the preceding processor
5137 nn=num_cont_hb(iatel_s)
5138 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5139 cd write (iout,*) 'The BUFFER array:'
5141 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5143 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5145 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5146 C Clear the contacts of the atom passed to the neighboring processor
5147 nn=num_cont_hb(iatel_s+1)
5149 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5151 num_cont_hb(iatel_s)=0
5153 cd write (iout,*) 'Processor ',MyID,MyRank,
5154 cd & ' is sending correlation contribution to processor',MyID-1,
5155 cd & ' msglen=',msglen
5156 cd write (*,*) 'Processor ',MyID,MyRank,
5157 cd & ' is sending correlation contribution to processor',MyID-1,
5158 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5159 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5160 cd write (iout,*) 'Processor ',MyID,
5161 cd & ' has sent correlation contribution to processor',MyID-1,
5162 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5163 cd write (*,*) 'Processor ',MyID,
5164 cd & ' has sent correlation contribution to processor',MyID-1,
5165 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5167 endif ! (MyRank.gt.0)
5171 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5172 if (MyRank.lt.fgProcs-1) then
5173 C Receive correlation contributions from the next processor
5175 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5176 cd write (iout,*) 'Processor',MyID,
5177 cd & ' is receiving correlation contribution from processor',MyID+1,
5178 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5179 cd write (*,*) 'Processor',MyID,
5180 cd & ' is receiving correlation contribution from processor',MyID+1,
5181 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5183 do while (nbytes.le.0)
5184 call mp_probe(MyID+1,CorrelType,nbytes)
5186 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5187 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5188 cd write (iout,*) 'Processor',MyID,
5189 cd & ' has received correlation contribution from processor',MyID+1,
5190 cd & ' msglen=',msglen,' nbytes=',nbytes
5191 cd write (iout,*) 'The received BUFFER array:'
5193 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5195 if (msglen.eq.msglen1) then
5196 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5197 else if (msglen.eq.msglen2) then
5198 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5199 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5202 & 'ERROR!!!! message length changed while processing correlations.'
5204 & 'ERROR!!!! message length changed while processing correlations.'
5205 call mp_stopall(Error)
5206 endif ! msglen.eq.msglen1
5207 endif ! MyRank.lt.fgProcs-1
5214 write (iout,'(a)') 'Contact function values:'
5216 write (iout,'(2i3,50(1x,i2,f5.2))')
5217 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5218 & j=1,num_cont_hb(i))
5222 C Remove the loop below after debugging !!!
5229 C Calculate the local-electrostatic correlation terms
5230 do i=iatel_s,iatel_e+1
5232 num_conti=num_cont_hb(i)
5233 num_conti1=num_cont_hb(i+1)
5238 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5239 c & ' jj=',jj,' kk=',kk
5240 if (j1.eq.j+1 .or. j1.eq.j-1) then
5241 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5242 C The system gains extra energy.
5243 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5245 else if (j1.eq.j) then
5246 C Contacts I-J and I-(J+1) occur simultaneously.
5247 C The system loses extra energy.
5248 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5253 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5254 c & ' jj=',jj,' kk=',kk
5256 C Contacts I-J and (I+1)-J occur simultaneously.
5257 C The system loses extra energy.
5258 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5265 c------------------------------------------------------------------------------
5266 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5268 C This subroutine calculates multi-body contributions to hydrogen-bonding
5269 implicit real*8 (a-h,o-z)
5270 include 'DIMENSIONS'
5271 include 'DIMENSIONS.ZSCOPT'
5272 include 'COMMON.IOUNITS'
5274 include 'COMMON.INFO'
5276 include 'COMMON.FFIELD'
5277 include 'COMMON.DERIV'
5278 include 'COMMON.INTERACT'
5279 include 'COMMON.CONTACTS'
5281 parameter (max_cont=maxconts)
5282 parameter (max_dim=2*(8*3+2))
5283 parameter (msglen1=max_cont*max_dim*4)
5284 parameter (msglen2=2*msglen1)
5285 integer source,CorrelType,CorrelID,Error
5286 double precision buffer(max_cont,max_dim)
5288 double precision gx(3),gx1(3)
5291 C Set lprn=.true. for debugging
5297 if (fgProcs.le.1) goto 30
5299 write (iout,'(a)') 'Contact function values:'
5301 write (iout,'(2i3,50(1x,i2,f5.2))')
5302 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5303 & j=1,num_cont_hb(i))
5306 C Caution! Following code assumes that electrostatic interactions concerning
5307 C a given atom are split among at most two processors!
5317 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5320 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5321 if (MyRank.gt.0) then
5322 C Send correlation contributions to the preceding processor
5324 nn=num_cont_hb(iatel_s)
5325 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5326 cd write (iout,*) 'The BUFFER array:'
5328 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5330 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5332 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5333 C Clear the contacts of the atom passed to the neighboring processor
5334 nn=num_cont_hb(iatel_s+1)
5336 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5338 num_cont_hb(iatel_s)=0
5340 cd write (iout,*) 'Processor ',MyID,MyRank,
5341 cd & ' is sending correlation contribution to processor',MyID-1,
5342 cd & ' msglen=',msglen
5343 cd write (*,*) 'Processor ',MyID,MyRank,
5344 cd & ' is sending correlation contribution to processor',MyID-1,
5345 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5346 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5347 cd write (iout,*) 'Processor ',MyID,
5348 cd & ' has sent correlation contribution to processor',MyID-1,
5349 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5350 cd write (*,*) 'Processor ',MyID,
5351 cd & ' has sent correlation contribution to processor',MyID-1,
5352 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5354 endif ! (MyRank.gt.0)
5358 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5359 if (MyRank.lt.fgProcs-1) then
5360 C Receive correlation contributions from the next processor
5362 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5363 cd write (iout,*) 'Processor',MyID,
5364 cd & ' is receiving correlation contribution from processor',MyID+1,
5365 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5366 cd write (*,*) 'Processor',MyID,
5367 cd & ' is receiving correlation contribution from processor',MyID+1,
5368 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5370 do while (nbytes.le.0)
5371 call mp_probe(MyID+1,CorrelType,nbytes)
5373 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5374 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5375 cd write (iout,*) 'Processor',MyID,
5376 cd & ' has received correlation contribution from processor',MyID+1,
5377 cd & ' msglen=',msglen,' nbytes=',nbytes
5378 cd write (iout,*) 'The received BUFFER array:'
5380 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5382 if (msglen.eq.msglen1) then
5383 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5384 else if (msglen.eq.msglen2) then
5385 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5386 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5389 & 'ERROR!!!! message length changed while processing correlations.'
5391 & 'ERROR!!!! message length changed while processing correlations.'
5392 call mp_stopall(Error)
5393 endif ! msglen.eq.msglen1
5394 endif ! MyRank.lt.fgProcs-1
5401 write (iout,'(a)') 'Contact function values:'
5403 write (iout,'(2i3,50(1x,i2,f5.2))')
5404 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5405 & j=1,num_cont_hb(i))
5411 C Remove the loop below after debugging !!!
5418 C Calculate the dipole-dipole interaction energies
5419 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5420 do i=iatel_s,iatel_e+1
5421 num_conti=num_cont_hb(i)
5428 C Calculate the local-electrostatic correlation terms
5429 do i=iatel_s,iatel_e+1
5431 num_conti=num_cont_hb(i)
5432 num_conti1=num_cont_hb(i+1)
5437 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5438 c & ' jj=',jj,' kk=',kk
5439 if (j1.eq.j+1 .or. j1.eq.j-1) then
5440 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5441 C The system gains extra energy.
5443 sqd1=dsqrt(d_cont(jj,i))
5444 sqd2=dsqrt(d_cont(kk,i1))
5445 sred_geom = sqd1*sqd2
5446 IF (sred_geom.lt.cutoff_corr) THEN
5447 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5449 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5450 c & ' jj=',jj,' kk=',kk
5451 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5452 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5454 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5455 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5458 cd write (iout,*) 'sred_geom=',sred_geom,
5459 cd & ' ekont=',ekont,' fprim=',fprimcont
5460 call calc_eello(i,j,i+1,j1,jj,kk)
5461 if (wcorr4.gt.0.0d0)
5462 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5463 if (wcorr5.gt.0.0d0)
5464 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5465 c print *,"wcorr5",ecorr5
5466 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5467 cd write(2,*)'ijkl',i,j,i+1,j1
5468 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5469 & .or. wturn6.eq.0.0d0))then
5470 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5471 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5472 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5473 cd & 'ecorr6=',ecorr6
5474 cd write (iout,'(4e15.5)') sred_geom,
5475 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5476 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5477 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5478 else if (wturn6.gt.0.0d0
5479 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5480 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5481 eturn6=eturn6+eello_turn6(i,jj,kk)
5482 cd write (2,*) 'multibody_eello:eturn6',eturn6
5486 else if (j1.eq.j) then
5487 C Contacts I-J and I-(J+1) occur simultaneously.
5488 C The system loses extra energy.
5489 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5494 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5495 c & ' jj=',jj,' kk=',kk
5497 C Contacts I-J and (I+1)-J occur simultaneously.
5498 C The system loses extra energy.
5499 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5506 c------------------------------------------------------------------------------
5507 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5508 implicit real*8 (a-h,o-z)
5509 include 'DIMENSIONS'
5510 include 'COMMON.IOUNITS'
5511 include 'COMMON.DERIV'
5512 include 'COMMON.INTERACT'
5513 include 'COMMON.CONTACTS'
5514 double precision gx(3),gx1(3)
5524 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5525 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5526 C Following 4 lines for diagnostics.
5531 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5533 c write (iout,*)'Contacts have occurred for peptide groups',
5534 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5535 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5536 C Calculate the multi-body contribution to energy.
5537 ecorr=ecorr+ekont*ees
5539 C Calculate multi-body contributions to the gradient.
5541 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5542 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5543 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5544 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5545 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5546 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5547 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5548 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5549 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5550 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5551 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5552 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5553 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5554 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5558 gradcorr(ll,m)=gradcorr(ll,m)+
5559 & ees*ekl*gacont_hbr(ll,jj,i)-
5560 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5561 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5566 gradcorr(ll,m)=gradcorr(ll,m)+
5567 & ees*eij*gacont_hbr(ll,kk,k)-
5568 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5569 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5576 C---------------------------------------------------------------------------
5577 subroutine dipole(i,j,jj)
5578 implicit real*8 (a-h,o-z)
5579 include 'DIMENSIONS'
5580 include 'DIMENSIONS.ZSCOPT'
5581 include 'COMMON.IOUNITS'
5582 include 'COMMON.CHAIN'
5583 include 'COMMON.FFIELD'
5584 include 'COMMON.DERIV'
5585 include 'COMMON.INTERACT'
5586 include 'COMMON.CONTACTS'
5587 include 'COMMON.TORSION'
5588 include 'COMMON.VAR'
5589 include 'COMMON.GEO'
5590 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5592 iti1 = itortyp(itype(i+1))
5593 if (j.lt.nres-1) then
5594 if (itype(j).le.ntyp) then
5595 itj1 = itortyp(itype(j+1))
5603 dipi(iii,1)=Ub2(iii,i)
5604 dipderi(iii)=Ub2der(iii,i)
5605 dipi(iii,2)=b1(iii,iti1)
5606 dipj(iii,1)=Ub2(iii,j)
5607 dipderj(iii)=Ub2der(iii,j)
5608 dipj(iii,2)=b1(iii,itj1)
5612 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5615 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5618 if (.not.calc_grad) return
5623 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5627 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5632 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5633 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5635 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5637 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5639 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5643 C---------------------------------------------------------------------------
5644 subroutine calc_eello(i,j,k,l,jj,kk)
5646 C This subroutine computes matrices and vectors needed to calculate
5647 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5649 implicit real*8 (a-h,o-z)
5650 include 'DIMENSIONS'
5651 include 'DIMENSIONS.ZSCOPT'
5652 include 'COMMON.IOUNITS'
5653 include 'COMMON.CHAIN'
5654 include 'COMMON.DERIV'
5655 include 'COMMON.INTERACT'
5656 include 'COMMON.CONTACTS'
5657 include 'COMMON.TORSION'
5658 include 'COMMON.VAR'
5659 include 'COMMON.GEO'
5660 include 'COMMON.FFIELD'
5661 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5662 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5665 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5666 cd & ' jj=',jj,' kk=',kk
5667 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5670 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5671 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5674 call transpose2(aa1(1,1),aa1t(1,1))
5675 call transpose2(aa2(1,1),aa2t(1,1))
5678 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5679 & aa1tder(1,1,lll,kkk))
5680 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5681 & aa2tder(1,1,lll,kkk))
5685 C parallel orientation of the two CA-CA-CA frames.
5686 if (i.gt.1 .and. itype(i).le.ntyp) then
5687 iti=itortyp(itype(i))
5691 itk1=itortyp(itype(k+1))
5692 itj=itortyp(itype(j))
5693 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5694 itl1=itortyp(itype(l+1))
5698 C A1 kernel(j+1) A2T
5700 cd write (iout,'(3f10.5,5x,3f10.5)')
5701 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5703 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5704 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5705 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5706 C Following matrices are needed only for 6-th order cumulants
5707 IF (wcorr6.gt.0.0d0) THEN
5708 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5709 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5710 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5711 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5712 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5713 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5714 & ADtEAderx(1,1,1,1,1,1))
5716 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5717 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5718 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5719 & ADtEA1derx(1,1,1,1,1,1))
5721 C End 6-th order cumulants
5724 cd write (2,*) 'In calc_eello6'
5726 cd write (2,*) 'iii=',iii
5728 cd write (2,*) 'kkk=',kkk
5730 cd write (2,'(3(2f10.5),5x)')
5731 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5736 call transpose2(EUgder(1,1,k),auxmat(1,1))
5737 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5738 call transpose2(EUg(1,1,k),auxmat(1,1))
5739 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5740 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5744 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5745 & EAEAderx(1,1,lll,kkk,iii,1))
5749 C A1T kernel(i+1) A2
5750 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5751 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5752 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5753 C Following matrices are needed only for 6-th order cumulants
5754 IF (wcorr6.gt.0.0d0) THEN
5755 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5756 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5757 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5758 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5759 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5760 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5761 & ADtEAderx(1,1,1,1,1,2))
5762 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5763 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5764 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5765 & ADtEA1derx(1,1,1,1,1,2))
5767 C End 6-th order cumulants
5768 call transpose2(EUgder(1,1,l),auxmat(1,1))
5769 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5770 call transpose2(EUg(1,1,l),auxmat(1,1))
5771 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5772 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5776 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5777 & EAEAderx(1,1,lll,kkk,iii,2))
5782 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5783 C They are needed only when the fifth- or the sixth-order cumulants are
5785 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5786 call transpose2(AEA(1,1,1),auxmat(1,1))
5787 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5788 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5789 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5790 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5791 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5792 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5793 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5794 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5795 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5796 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5797 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5798 call transpose2(AEA(1,1,2),auxmat(1,1))
5799 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5800 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5801 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5802 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5803 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5804 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5805 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5806 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5807 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5808 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5809 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5810 C Calculate the Cartesian derivatives of the vectors.
5814 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5815 call matvec2(auxmat(1,1),b1(1,iti),
5816 & AEAb1derx(1,lll,kkk,iii,1,1))
5817 call matvec2(auxmat(1,1),Ub2(1,i),
5818 & AEAb2derx(1,lll,kkk,iii,1,1))
5819 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5820 & AEAb1derx(1,lll,kkk,iii,2,1))
5821 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5822 & AEAb2derx(1,lll,kkk,iii,2,1))
5823 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5824 call matvec2(auxmat(1,1),b1(1,itj),
5825 & AEAb1derx(1,lll,kkk,iii,1,2))
5826 call matvec2(auxmat(1,1),Ub2(1,j),
5827 & AEAb2derx(1,lll,kkk,iii,1,2))
5828 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5829 & AEAb1derx(1,lll,kkk,iii,2,2))
5830 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5831 & AEAb2derx(1,lll,kkk,iii,2,2))
5838 C Antiparallel orientation of the two CA-CA-CA frames.
5839 if (i.gt.1 .and. itype(i).le.ntyp) then
5840 iti=itortyp(itype(i))
5844 itk1=itortyp(itype(k+1))
5845 itl=itortyp(itype(l))
5846 itj=itortyp(itype(j))
5847 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5848 itj1=itortyp(itype(j+1))
5852 C A2 kernel(j-1)T A1T
5853 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5854 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5855 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5856 C Following matrices are needed only for 6-th order cumulants
5857 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5858 & j.eq.i+4 .and. l.eq.i+3)) THEN
5859 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5860 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5861 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5862 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5863 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5864 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5865 & ADtEAderx(1,1,1,1,1,1))
5866 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5867 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5868 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5869 & ADtEA1derx(1,1,1,1,1,1))
5871 C End 6-th order cumulants
5872 call transpose2(EUgder(1,1,k),auxmat(1,1))
5873 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5874 call transpose2(EUg(1,1,k),auxmat(1,1))
5875 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5876 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5880 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5881 & EAEAderx(1,1,lll,kkk,iii,1))
5885 C A2T kernel(i+1)T A1
5886 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5887 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5888 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5889 C Following matrices are needed only for 6-th order cumulants
5890 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5891 & j.eq.i+4 .and. l.eq.i+3)) THEN
5892 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5893 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5894 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5895 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5896 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5897 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5898 & ADtEAderx(1,1,1,1,1,2))
5899 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5900 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5901 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5902 & ADtEA1derx(1,1,1,1,1,2))
5904 C End 6-th order cumulants
5905 call transpose2(EUgder(1,1,j),auxmat(1,1))
5906 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5907 call transpose2(EUg(1,1,j),auxmat(1,1))
5908 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5909 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5913 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5914 & EAEAderx(1,1,lll,kkk,iii,2))
5919 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5920 C They are needed only when the fifth- or the sixth-order cumulants are
5922 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5923 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5924 call transpose2(AEA(1,1,1),auxmat(1,1))
5925 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5926 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5927 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5928 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5929 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5930 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5931 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5932 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5933 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5934 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5935 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5936 call transpose2(AEA(1,1,2),auxmat(1,1))
5937 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5938 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5939 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5940 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5941 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5942 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5943 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5944 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5945 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5946 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5947 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5948 C Calculate the Cartesian derivatives of the vectors.
5952 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5953 call matvec2(auxmat(1,1),b1(1,iti),
5954 & AEAb1derx(1,lll,kkk,iii,1,1))
5955 call matvec2(auxmat(1,1),Ub2(1,i),
5956 & AEAb2derx(1,lll,kkk,iii,1,1))
5957 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5958 & AEAb1derx(1,lll,kkk,iii,2,1))
5959 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5960 & AEAb2derx(1,lll,kkk,iii,2,1))
5961 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5962 call matvec2(auxmat(1,1),b1(1,itl),
5963 & AEAb1derx(1,lll,kkk,iii,1,2))
5964 call matvec2(auxmat(1,1),Ub2(1,l),
5965 & AEAb2derx(1,lll,kkk,iii,1,2))
5966 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5967 & AEAb1derx(1,lll,kkk,iii,2,2))
5968 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5969 & AEAb2derx(1,lll,kkk,iii,2,2))
5978 C---------------------------------------------------------------------------
5979 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5980 & KK,KKderg,AKA,AKAderg,AKAderx)
5984 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5985 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5986 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5991 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5993 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5996 cd if (lprn) write (2,*) 'In kernel'
5998 cd if (lprn) write (2,*) 'kkk=',kkk
6000 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6001 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6003 cd write (2,*) 'lll=',lll
6004 cd write (2,*) 'iii=1'
6006 cd write (2,'(3(2f10.5),5x)')
6007 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6010 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6011 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6013 cd write (2,*) 'lll=',lll
6014 cd write (2,*) 'iii=2'
6016 cd write (2,'(3(2f10.5),5x)')
6017 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6024 C---------------------------------------------------------------------------
6025 double precision function eello4(i,j,k,l,jj,kk)
6026 implicit real*8 (a-h,o-z)
6027 include 'DIMENSIONS'
6028 include 'DIMENSIONS.ZSCOPT'
6029 include 'COMMON.IOUNITS'
6030 include 'COMMON.CHAIN'
6031 include 'COMMON.DERIV'
6032 include 'COMMON.INTERACT'
6033 include 'COMMON.CONTACTS'
6034 include 'COMMON.TORSION'
6035 include 'COMMON.VAR'
6036 include 'COMMON.GEO'
6037 double precision pizda(2,2),ggg1(3),ggg2(3)
6038 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6042 cd print *,'eello4:',i,j,k,l,jj,kk
6043 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6044 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6045 cold eij=facont_hb(jj,i)
6046 cold ekl=facont_hb(kk,k)
6048 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6050 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6051 gcorr_loc(k-1)=gcorr_loc(k-1)
6052 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6054 gcorr_loc(l-1)=gcorr_loc(l-1)
6055 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6057 gcorr_loc(j-1)=gcorr_loc(j-1)
6058 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6063 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6064 & -EAEAderx(2,2,lll,kkk,iii,1)
6065 cd derx(lll,kkk,iii)=0.0d0
6069 cd gcorr_loc(l-1)=0.0d0
6070 cd gcorr_loc(j-1)=0.0d0
6071 cd gcorr_loc(k-1)=0.0d0
6073 cd write (iout,*)'Contacts have occurred for peptide groups',
6074 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6075 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6076 if (j.lt.nres-1) then
6083 if (l.lt.nres-1) then
6091 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6092 ggg1(ll)=eel4*g_contij(ll,1)
6093 ggg2(ll)=eel4*g_contij(ll,2)
6094 ghalf=0.5d0*ggg1(ll)
6096 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6097 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6098 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6099 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6100 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6101 ghalf=0.5d0*ggg2(ll)
6103 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6104 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6105 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6106 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6111 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6112 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6117 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6118 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6124 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6129 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6133 cd write (2,*) iii,gcorr_loc(iii)
6137 cd write (2,*) 'ekont',ekont
6138 cd write (iout,*) 'eello4',ekont*eel4
6141 C---------------------------------------------------------------------------
6142 double precision function eello5(i,j,k,l,jj,kk)
6143 implicit real*8 (a-h,o-z)
6144 include 'DIMENSIONS'
6145 include 'DIMENSIONS.ZSCOPT'
6146 include 'COMMON.IOUNITS'
6147 include 'COMMON.CHAIN'
6148 include 'COMMON.DERIV'
6149 include 'COMMON.INTERACT'
6150 include 'COMMON.CONTACTS'
6151 include 'COMMON.TORSION'
6152 include 'COMMON.VAR'
6153 include 'COMMON.GEO'
6154 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6155 double precision ggg1(3),ggg2(3)
6156 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6161 C /l\ / \ \ / \ / \ / C
6162 C / \ / \ \ / \ / \ / C
6163 C j| o |l1 | o | o| o | | o |o C
6164 C \ |/k\| |/ \| / |/ \| |/ \| C
6165 C \i/ \ / \ / / \ / \ C
6167 C (I) (II) (III) (IV) C
6169 C eello5_1 eello5_2 eello5_3 eello5_4 C
6171 C Antiparallel chains C
6174 C /j\ / \ \ / \ / \ / C
6175 C / \ / \ \ / \ / \ / C
6176 C j1| o |l | o | o| o | | o |o C
6177 C \ |/k\| |/ \| / |/ \| |/ \| C
6178 C \i/ \ / \ / / \ / \ C
6180 C (I) (II) (III) (IV) C
6182 C eello5_1 eello5_2 eello5_3 eello5_4 C
6184 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6186 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6187 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6192 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6194 itk=itortyp(itype(k))
6195 itl=itortyp(itype(l))
6196 itj=itortyp(itype(j))
6201 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6202 cd & eel5_3_num,eel5_4_num)
6206 derx(lll,kkk,iii)=0.0d0
6210 cd eij=facont_hb(jj,i)
6211 cd ekl=facont_hb(kk,k)
6213 cd write (iout,*)'Contacts have occurred for peptide groups',
6214 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6216 C Contribution from the graph I.
6217 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6218 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6219 call transpose2(EUg(1,1,k),auxmat(1,1))
6220 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6221 vv(1)=pizda(1,1)-pizda(2,2)
6222 vv(2)=pizda(1,2)+pizda(2,1)
6223 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6224 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6226 C Explicit gradient in virtual-dihedral angles.
6227 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6228 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6229 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6230 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6231 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6232 vv(1)=pizda(1,1)-pizda(2,2)
6233 vv(2)=pizda(1,2)+pizda(2,1)
6234 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6235 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6236 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6237 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6238 vv(1)=pizda(1,1)-pizda(2,2)
6239 vv(2)=pizda(1,2)+pizda(2,1)
6241 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6242 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6243 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6245 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6246 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6247 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6249 C Cartesian gradient
6253 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6255 vv(1)=pizda(1,1)-pizda(2,2)
6256 vv(2)=pizda(1,2)+pizda(2,1)
6257 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6258 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6259 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6266 C Contribution from graph II
6267 call transpose2(EE(1,1,itk),auxmat(1,1))
6268 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6269 vv(1)=pizda(1,1)+pizda(2,2)
6270 vv(2)=pizda(2,1)-pizda(1,2)
6271 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6272 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6274 C Explicit gradient in virtual-dihedral angles.
6275 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6276 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6277 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6278 vv(1)=pizda(1,1)+pizda(2,2)
6279 vv(2)=pizda(2,1)-pizda(1,2)
6281 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6282 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6283 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6285 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6286 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6287 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6289 C Cartesian gradient
6293 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6295 vv(1)=pizda(1,1)+pizda(2,2)
6296 vv(2)=pizda(2,1)-pizda(1,2)
6297 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6298 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6299 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6308 C Parallel orientation
6309 C Contribution from graph III
6310 call transpose2(EUg(1,1,l),auxmat(1,1))
6311 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6312 vv(1)=pizda(1,1)-pizda(2,2)
6313 vv(2)=pizda(1,2)+pizda(2,1)
6314 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6315 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6317 C Explicit gradient in virtual-dihedral angles.
6318 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6319 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6320 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6321 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6322 vv(1)=pizda(1,1)-pizda(2,2)
6323 vv(2)=pizda(1,2)+pizda(2,1)
6324 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6325 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6326 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6327 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6328 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6329 vv(1)=pizda(1,1)-pizda(2,2)
6330 vv(2)=pizda(1,2)+pizda(2,1)
6331 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6332 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6333 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6334 C Cartesian gradient
6338 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6340 vv(1)=pizda(1,1)-pizda(2,2)
6341 vv(2)=pizda(1,2)+pizda(2,1)
6342 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6343 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6344 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6350 C Contribution from graph IV
6352 call transpose2(EE(1,1,itl),auxmat(1,1))
6353 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6354 vv(1)=pizda(1,1)+pizda(2,2)
6355 vv(2)=pizda(2,1)-pizda(1,2)
6356 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6357 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6359 C Explicit gradient in virtual-dihedral angles.
6360 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6361 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6362 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6363 vv(1)=pizda(1,1)+pizda(2,2)
6364 vv(2)=pizda(2,1)-pizda(1,2)
6365 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6366 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6367 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6368 C Cartesian gradient
6372 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6374 vv(1)=pizda(1,1)+pizda(2,2)
6375 vv(2)=pizda(2,1)-pizda(1,2)
6376 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6377 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6378 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6384 C Antiparallel orientation
6385 C Contribution from graph III
6387 call transpose2(EUg(1,1,j),auxmat(1,1))
6388 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6389 vv(1)=pizda(1,1)-pizda(2,2)
6390 vv(2)=pizda(1,2)+pizda(2,1)
6391 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6392 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6394 C Explicit gradient in virtual-dihedral angles.
6395 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6396 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6397 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6398 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6399 vv(1)=pizda(1,1)-pizda(2,2)
6400 vv(2)=pizda(1,2)+pizda(2,1)
6401 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6402 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6403 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6404 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6405 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6406 vv(1)=pizda(1,1)-pizda(2,2)
6407 vv(2)=pizda(1,2)+pizda(2,1)
6408 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6409 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6410 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6411 C Cartesian gradient
6415 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6417 vv(1)=pizda(1,1)-pizda(2,2)
6418 vv(2)=pizda(1,2)+pizda(2,1)
6419 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6420 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6421 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6427 C Contribution from graph IV
6429 call transpose2(EE(1,1,itj),auxmat(1,1))
6430 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6431 vv(1)=pizda(1,1)+pizda(2,2)
6432 vv(2)=pizda(2,1)-pizda(1,2)
6433 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6434 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6436 C Explicit gradient in virtual-dihedral angles.
6437 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6438 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6439 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6440 vv(1)=pizda(1,1)+pizda(2,2)
6441 vv(2)=pizda(2,1)-pizda(1,2)
6442 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6443 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6444 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6445 C Cartesian gradient
6449 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6451 vv(1)=pizda(1,1)+pizda(2,2)
6452 vv(2)=pizda(2,1)-pizda(1,2)
6453 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6454 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6455 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6462 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6463 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6464 cd write (2,*) 'ijkl',i,j,k,l
6465 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6466 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6468 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6469 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6470 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6471 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6473 if (j.lt.nres-1) then
6480 if (l.lt.nres-1) then
6490 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6492 ggg1(ll)=eel5*g_contij(ll,1)
6493 ggg2(ll)=eel5*g_contij(ll,2)
6494 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6495 ghalf=0.5d0*ggg1(ll)
6497 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6498 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6499 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6500 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6501 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6502 ghalf=0.5d0*ggg2(ll)
6504 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6505 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6506 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6507 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6512 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6513 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6518 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6519 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6525 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6530 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6534 cd write (2,*) iii,g_corr5_loc(iii)
6538 cd write (2,*) 'ekont',ekont
6539 cd write (iout,*) 'eello5',ekont*eel5
6542 c--------------------------------------------------------------------------
6543 double precision function eello6(i,j,k,l,jj,kk)
6544 implicit real*8 (a-h,o-z)
6545 include 'DIMENSIONS'
6546 include 'DIMENSIONS.ZSCOPT'
6547 include 'COMMON.IOUNITS'
6548 include 'COMMON.CHAIN'
6549 include 'COMMON.DERIV'
6550 include 'COMMON.INTERACT'
6551 include 'COMMON.CONTACTS'
6552 include 'COMMON.TORSION'
6553 include 'COMMON.VAR'
6554 include 'COMMON.GEO'
6555 include 'COMMON.FFIELD'
6556 double precision ggg1(3),ggg2(3)
6557 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6562 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6570 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6571 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6575 derx(lll,kkk,iii)=0.0d0
6579 cd eij=facont_hb(jj,i)
6580 cd ekl=facont_hb(kk,k)
6586 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6587 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6588 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6589 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6590 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6591 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6593 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6594 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6595 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6596 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6597 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6598 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6602 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6604 C If turn contributions are considered, they will be handled separately.
6605 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6606 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6607 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6608 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6609 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6610 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6611 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6614 if (j.lt.nres-1) then
6621 if (l.lt.nres-1) then
6629 ggg1(ll)=eel6*g_contij(ll,1)
6630 ggg2(ll)=eel6*g_contij(ll,2)
6631 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6632 ghalf=0.5d0*ggg1(ll)
6634 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6635 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6636 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6637 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6638 ghalf=0.5d0*ggg2(ll)
6639 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6641 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6642 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6643 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6644 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6649 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6650 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6655 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6656 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6662 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6667 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6671 cd write (2,*) iii,g_corr6_loc(iii)
6675 cd write (2,*) 'ekont',ekont
6676 cd write (iout,*) 'eello6',ekont*eel6
6679 c--------------------------------------------------------------------------
6680 double precision function eello6_graph1(i,j,k,l,imat,swap)
6681 implicit real*8 (a-h,o-z)
6682 include 'DIMENSIONS'
6683 include 'DIMENSIONS.ZSCOPT'
6684 include 'COMMON.IOUNITS'
6685 include 'COMMON.CHAIN'
6686 include 'COMMON.DERIV'
6687 include 'COMMON.INTERACT'
6688 include 'COMMON.CONTACTS'
6689 include 'COMMON.TORSION'
6690 include 'COMMON.VAR'
6691 include 'COMMON.GEO'
6692 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6696 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6698 C Parallel Antiparallel C
6704 C \ j|/k\| / \ |/k\|l / C
6709 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6710 itk=itortyp(itype(k))
6711 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6712 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6713 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6714 call transpose2(EUgC(1,1,k),auxmat(1,1))
6715 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6716 vv1(1)=pizda1(1,1)-pizda1(2,2)
6717 vv1(2)=pizda1(1,2)+pizda1(2,1)
6718 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6719 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6720 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6721 s5=scalar2(vv(1),Dtobr2(1,i))
6722 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6723 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6724 if (.not. calc_grad) return
6725 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6726 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6727 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6728 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6729 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6730 & +scalar2(vv(1),Dtobr2der(1,i)))
6731 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6732 vv1(1)=pizda1(1,1)-pizda1(2,2)
6733 vv1(2)=pizda1(1,2)+pizda1(2,1)
6734 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6735 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6737 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6738 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6739 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6740 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6741 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6743 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6744 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6745 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6746 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6747 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6749 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6750 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6751 vv1(1)=pizda1(1,1)-pizda1(2,2)
6752 vv1(2)=pizda1(1,2)+pizda1(2,1)
6753 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6754 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6755 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6756 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6765 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6766 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6767 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6768 call transpose2(EUgC(1,1,k),auxmat(1,1))
6769 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6771 vv1(1)=pizda1(1,1)-pizda1(2,2)
6772 vv1(2)=pizda1(1,2)+pizda1(2,1)
6773 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6774 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6775 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6776 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6777 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6778 s5=scalar2(vv(1),Dtobr2(1,i))
6779 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6785 c----------------------------------------------------------------------------
6786 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6787 implicit real*8 (a-h,o-z)
6788 include 'DIMENSIONS'
6789 include 'DIMENSIONS.ZSCOPT'
6790 include 'COMMON.IOUNITS'
6791 include 'COMMON.CHAIN'
6792 include 'COMMON.DERIV'
6793 include 'COMMON.INTERACT'
6794 include 'COMMON.CONTACTS'
6795 include 'COMMON.TORSION'
6796 include 'COMMON.VAR'
6797 include 'COMMON.GEO'
6799 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6800 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6803 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6805 C Parallel Antiparallel C
6811 C \ j|/k\| \ |/k\|l C
6816 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6817 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6818 C AL 7/4/01 s1 would occur in the sixth-order moment,
6819 C but not in a cluster cumulant
6821 s1=dip(1,jj,i)*dip(1,kk,k)
6823 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6824 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6825 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6826 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6827 call transpose2(EUg(1,1,k),auxmat(1,1))
6828 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6829 vv(1)=pizda(1,1)-pizda(2,2)
6830 vv(2)=pizda(1,2)+pizda(2,1)
6831 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6832 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6834 eello6_graph2=-(s1+s2+s3+s4)
6836 eello6_graph2=-(s2+s3+s4)
6839 if (.not. calc_grad) return
6840 C Derivatives in gamma(i-1)
6843 s1=dipderg(1,jj,i)*dip(1,kk,k)
6845 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6846 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6847 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6848 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6850 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6852 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6854 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6856 C Derivatives in gamma(k-1)
6858 s1=dip(1,jj,i)*dipderg(1,kk,k)
6860 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6861 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6862 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6863 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6864 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6865 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6866 vv(1)=pizda(1,1)-pizda(2,2)
6867 vv(2)=pizda(1,2)+pizda(2,1)
6868 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6870 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6872 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6874 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6875 C Derivatives in gamma(j-1) or gamma(l-1)
6878 s1=dipderg(3,jj,i)*dip(1,kk,k)
6880 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6881 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6882 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6883 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6884 vv(1)=pizda(1,1)-pizda(2,2)
6885 vv(2)=pizda(1,2)+pizda(2,1)
6886 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6889 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6891 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6894 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6895 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6897 C Derivatives in gamma(l-1) or gamma(j-1)
6900 s1=dip(1,jj,i)*dipderg(3,kk,k)
6902 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6903 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6904 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6905 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6906 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6907 vv(1)=pizda(1,1)-pizda(2,2)
6908 vv(2)=pizda(1,2)+pizda(2,1)
6909 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6912 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6914 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6917 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6918 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6920 C Cartesian derivatives.
6922 write (2,*) 'In eello6_graph2'
6924 write (2,*) 'iii=',iii
6926 write (2,*) 'kkk=',kkk
6928 write (2,'(3(2f10.5),5x)')
6929 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6939 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6941 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6944 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6946 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6947 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6949 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6950 call transpose2(EUg(1,1,k),auxmat(1,1))
6951 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6953 vv(1)=pizda(1,1)-pizda(2,2)
6954 vv(2)=pizda(1,2)+pizda(2,1)
6955 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6956 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6958 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6960 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6963 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6965 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6972 c----------------------------------------------------------------------------
6973 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6974 implicit real*8 (a-h,o-z)
6975 include 'DIMENSIONS'
6976 include 'DIMENSIONS.ZSCOPT'
6977 include 'COMMON.IOUNITS'
6978 include 'COMMON.CHAIN'
6979 include 'COMMON.DERIV'
6980 include 'COMMON.INTERACT'
6981 include 'COMMON.CONTACTS'
6982 include 'COMMON.TORSION'
6983 include 'COMMON.VAR'
6984 include 'COMMON.GEO'
6985 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6987 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6989 C Parallel Antiparallel C
6995 C j|/k\| / |/k\|l / C
7000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7002 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7003 C energy moment and not to the cluster cumulant.
7004 iti=itortyp(itype(i))
7005 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7006 itj1=itortyp(itype(j+1))
7010 itk=itortyp(itype(k))
7011 itk1=itortyp(itype(k+1))
7012 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7013 itl1=itortyp(itype(l+1))
7018 s1=dip(4,jj,i)*dip(4,kk,k)
7020 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7021 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7022 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7023 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7024 call transpose2(EE(1,1,itk),auxmat(1,1))
7025 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7026 vv(1)=pizda(1,1)+pizda(2,2)
7027 vv(2)=pizda(2,1)-pizda(1,2)
7028 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7029 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7031 eello6_graph3=-(s1+s2+s3+s4)
7033 eello6_graph3=-(s2+s3+s4)
7036 if (.not. calc_grad) return
7037 C Derivatives in gamma(k-1)
7038 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7039 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7040 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7041 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7042 C Derivatives in gamma(l-1)
7043 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7044 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7045 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7046 vv(1)=pizda(1,1)+pizda(2,2)
7047 vv(2)=pizda(2,1)-pizda(1,2)
7048 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7049 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7050 C Cartesian derivatives.
7056 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7058 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7061 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7063 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7064 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7066 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7067 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7069 vv(1)=pizda(1,1)+pizda(2,2)
7070 vv(2)=pizda(2,1)-pizda(1,2)
7071 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7073 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7075 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7078 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7080 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7082 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7088 c----------------------------------------------------------------------------
7089 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7090 implicit real*8 (a-h,o-z)
7091 include 'DIMENSIONS'
7092 include 'DIMENSIONS.ZSCOPT'
7093 include 'COMMON.IOUNITS'
7094 include 'COMMON.CHAIN'
7095 include 'COMMON.DERIV'
7096 include 'COMMON.INTERACT'
7097 include 'COMMON.CONTACTS'
7098 include 'COMMON.TORSION'
7099 include 'COMMON.VAR'
7100 include 'COMMON.GEO'
7101 include 'COMMON.FFIELD'
7102 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7103 & auxvec1(2),auxmat1(2,2)
7105 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7107 C Parallel Antiparallel C
7113 C \ j|/k\| \ |/k\|l C
7118 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7120 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7121 C energy moment and not to the cluster cumulant.
7122 cd write (2,*) 'eello_graph4: wturn6',wturn6
7123 iti=itortyp(itype(i))
7124 itj=itortyp(itype(j))
7125 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7126 itj1=itortyp(itype(j+1))
7130 itk=itortyp(itype(k))
7131 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7132 itk1=itortyp(itype(k+1))
7136 itl=itortyp(itype(l))
7137 if (l.lt.nres-1) then
7138 itl1=itortyp(itype(l+1))
7142 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7143 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7144 cd & ' itl',itl,' itl1',itl1
7147 s1=dip(3,jj,i)*dip(3,kk,k)
7149 s1=dip(2,jj,j)*dip(2,kk,l)
7152 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7153 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7155 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7156 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7158 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7159 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7161 call transpose2(EUg(1,1,k),auxmat(1,1))
7162 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7163 vv(1)=pizda(1,1)-pizda(2,2)
7164 vv(2)=pizda(2,1)+pizda(1,2)
7165 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7166 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7168 eello6_graph4=-(s1+s2+s3+s4)
7170 eello6_graph4=-(s2+s3+s4)
7172 if (.not. calc_grad) return
7173 C Derivatives in gamma(i-1)
7177 s1=dipderg(2,jj,i)*dip(3,kk,k)
7179 s1=dipderg(4,jj,j)*dip(2,kk,l)
7182 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7184 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7185 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7187 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7188 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7190 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7191 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7192 cd write (2,*) 'turn6 derivatives'
7194 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7196 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7200 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7202 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7206 C Derivatives in gamma(k-1)
7209 s1=dip(3,jj,i)*dipderg(2,kk,k)
7211 s1=dip(2,jj,j)*dipderg(4,kk,l)
7214 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7215 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7217 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7218 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7220 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7221 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7223 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7224 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7225 vv(1)=pizda(1,1)-pizda(2,2)
7226 vv(2)=pizda(2,1)+pizda(1,2)
7227 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7228 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7230 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7232 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7236 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7238 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7241 C Derivatives in gamma(j-1) or gamma(l-1)
7242 if (l.eq.j+1 .and. l.gt.1) then
7243 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7244 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7245 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7246 vv(1)=pizda(1,1)-pizda(2,2)
7247 vv(2)=pizda(2,1)+pizda(1,2)
7248 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7249 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7250 else if (j.gt.1) then
7251 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7252 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7253 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7254 vv(1)=pizda(1,1)-pizda(2,2)
7255 vv(2)=pizda(2,1)+pizda(1,2)
7256 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7257 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7258 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7260 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7263 C Cartesian derivatives.
7270 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7272 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7276 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7278 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7282 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7284 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7286 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7287 & b1(1,itj1),auxvec(1))
7288 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7290 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7291 & b1(1,itl1),auxvec(1))
7292 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7294 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7296 vv(1)=pizda(1,1)-pizda(2,2)
7297 vv(2)=pizda(2,1)+pizda(1,2)
7298 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7300 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7302 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7305 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7308 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7311 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7313 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7315 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7319 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7321 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7324 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7326 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7334 c----------------------------------------------------------------------------
7335 double precision function eello_turn6(i,jj,kk)
7336 implicit real*8 (a-h,o-z)
7337 include 'DIMENSIONS'
7338 include 'DIMENSIONS.ZSCOPT'
7339 include 'COMMON.IOUNITS'
7340 include 'COMMON.CHAIN'
7341 include 'COMMON.DERIV'
7342 include 'COMMON.INTERACT'
7343 include 'COMMON.CONTACTS'
7344 include 'COMMON.TORSION'
7345 include 'COMMON.VAR'
7346 include 'COMMON.GEO'
7347 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7348 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7350 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7351 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7352 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7353 C the respective energy moment and not to the cluster cumulant.
7358 iti=itortyp(itype(i))
7359 itk=itortyp(itype(k))
7360 itk1=itortyp(itype(k+1))
7361 itl=itortyp(itype(l))
7362 itj=itortyp(itype(j))
7363 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7364 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7365 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7370 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7372 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7376 derx_turn(lll,kkk,iii)=0.0d0
7383 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7385 cd write (2,*) 'eello6_5',eello6_5
7387 call transpose2(AEA(1,1,1),auxmat(1,1))
7388 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7389 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7390 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7394 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7395 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7396 s2 = scalar2(b1(1,itk),vtemp1(1))
7398 call transpose2(AEA(1,1,2),atemp(1,1))
7399 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7400 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7401 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7405 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7406 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7407 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7409 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7410 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7411 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7412 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7413 ss13 = scalar2(b1(1,itk),vtemp4(1))
7414 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7418 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7424 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7426 C Derivatives in gamma(i+2)
7428 call transpose2(AEA(1,1,1),auxmatd(1,1))
7429 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7430 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7431 call transpose2(AEAderg(1,1,2),atempd(1,1))
7432 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7433 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7437 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7438 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7439 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7445 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7446 C Derivatives in gamma(i+3)
7448 call transpose2(AEA(1,1,1),auxmatd(1,1))
7449 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7450 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7451 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7455 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7456 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7457 s2d = scalar2(b1(1,itk),vtemp1d(1))
7459 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7460 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7462 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7464 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7465 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7466 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7476 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7477 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7479 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7480 & -0.5d0*ekont*(s2d+s12d)
7482 C Derivatives in gamma(i+4)
7483 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7484 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7485 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7487 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7488 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7489 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7499 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7501 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7503 C Derivatives in gamma(i+5)
7505 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7506 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7507 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7511 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7512 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7513 s2d = scalar2(b1(1,itk),vtemp1d(1))
7515 call transpose2(AEA(1,1,2),atempd(1,1))
7516 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7517 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7521 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7522 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7524 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7525 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7526 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7536 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7537 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7539 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7540 & -0.5d0*ekont*(s2d+s12d)
7542 C Cartesian derivatives
7547 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7548 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7549 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7553 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7554 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7556 s2d = scalar2(b1(1,itk),vtemp1d(1))
7558 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7559 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7560 s8d = -(atempd(1,1)+atempd(2,2))*
7561 & scalar2(cc(1,1,itl),vtemp2(1))
7565 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7567 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7568 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7575 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7578 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7582 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7583 & - 0.5d0*(s8d+s12d)
7585 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7594 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7596 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7597 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7598 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7599 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7600 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7602 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7603 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7604 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7608 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7609 cd & 16*eel_turn6_num
7611 if (j.lt.nres-1) then
7618 if (l.lt.nres-1) then
7626 ggg1(ll)=eel_turn6*g_contij(ll,1)
7627 ggg2(ll)=eel_turn6*g_contij(ll,2)
7628 ghalf=0.5d0*ggg1(ll)
7630 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7631 & +ekont*derx_turn(ll,2,1)
7632 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7633 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7634 & +ekont*derx_turn(ll,4,1)
7635 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7636 ghalf=0.5d0*ggg2(ll)
7638 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7639 & +ekont*derx_turn(ll,2,2)
7640 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7641 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7642 & +ekont*derx_turn(ll,4,2)
7643 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7648 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7653 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7659 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7664 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7668 cd write (2,*) iii,g_corr6_loc(iii)
7671 eello_turn6=ekont*eel_turn6
7672 cd write (2,*) 'ekont',ekont
7673 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7676 crc-------------------------------------------------
7677 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7678 subroutine Eliptransfer(eliptran)
7679 implicit real*8 (a-h,o-z)
7680 include 'DIMENSIONS'
7681 include 'COMMON.GEO'
7682 include 'COMMON.VAR'
7683 include 'COMMON.LOCAL'
7684 include 'COMMON.CHAIN'
7685 include 'COMMON.DERIV'
7686 include 'COMMON.INTERACT'
7687 include 'COMMON.IOUNITS'
7688 include 'COMMON.CALC'
7689 include 'COMMON.CONTROL'
7690 include 'COMMON.SPLITELE'
7691 include 'COMMON.SBRIDGE'
7692 C this is done by Adasko
7696 C--bordliptop-- buffore starts
7697 C--bufliptop--- here true lipid starts
7699 C--buflipbot--- lipid ends buffore starts
7700 C--bordlipbot--buffore ends
7704 if (itype(i).eq.ntyp1) cycle
7706 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
7707 if (positi.le.0) positi=positi+boxzsize
7709 C first for peptide groups
7710 c for each residue check if it is in lipid or lipid water border area
7711 if ((positi.gt.bordlipbot)
7712 &.and.(positi.lt.bordliptop)) then
7713 C the energy transfer exist
7714 if (positi.lt.buflipbot) then
7715 C what fraction I am in
7717 & ((positi-bordlipbot)/lipbufthick)
7718 C lipbufthick is thickenes of lipid buffore
7719 sslip=sscalelip(fracinbuf)
7720 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
7721 eliptran=eliptran+sslip*pepliptran
7722 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
7723 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
7724 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
7725 elseif (positi.gt.bufliptop) then
7726 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
7727 sslip=sscalelip(fracinbuf)
7728 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
7729 eliptran=eliptran+sslip*pepliptran
7730 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
7731 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
7732 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
7733 C print *, "doing sscalefor top part"
7734 C print *,i,sslip,fracinbuf,ssgradlip
7736 eliptran=eliptran+pepliptran
7737 C print *,"I am in true lipid"
7740 C eliptran=elpitran+0.0 ! I am in water
7743 C print *, "nic nie bylo w lipidzie?"
7744 C now multiply all by the peptide group transfer factor
7745 C eliptran=eliptran*pepliptran
7746 C now the same for side chains
7749 if (itype(i).eq.ntyp1) cycle
7750 positi=(mod(c(3,i+nres),boxzsize))
7751 if (positi.le.0) positi=positi+boxzsize
7752 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
7753 c for each residue check if it is in lipid or lipid water border area
7754 C respos=mod(c(3,i+nres),boxzsize)
7755 C print *,positi,bordlipbot,buflipbot
7756 if ((positi.gt.bordlipbot)
7757 & .and.(positi.lt.bordliptop)) then
7758 C the energy transfer exist
7759 if (positi.lt.buflipbot) then
7761 & ((positi-bordlipbot)/lipbufthick)
7762 C lipbufthick is thickenes of lipid buffore
7763 sslip=sscalelip(fracinbuf)
7764 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
7765 eliptran=eliptran+sslip*liptranene(itype(i))
7766 gliptranx(3,i)=gliptranx(3,i)
7767 &+ssgradlip*liptranene(itype(i))
7768 gliptranc(3,i-1)= gliptranc(3,i-1)
7769 &+ssgradlip*liptranene(itype(i))
7770 C print *,"doing sccale for lower part"
7771 elseif (positi.gt.bufliptop) then
7773 &((bordliptop-positi)/lipbufthick)
7774 sslip=sscalelip(fracinbuf)
7775 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
7776 eliptran=eliptran+sslip*liptranene(itype(i))
7777 gliptranx(3,i)=gliptranx(3,i)
7778 &+ssgradlip*liptranene(itype(i))
7779 gliptranc(3,i-1)= gliptranc(3,i-1)
7780 &+ssgradlip*liptranene(itype(i))
7781 C print *, "doing sscalefor top part",sslip,fracinbuf
7783 eliptran=eliptran+liptranene(itype(i))
7784 C print *,"I am in true lipid"
7786 endif ! if in lipid or buffor
7788 C eliptran=elpitran+0.0 ! I am in water
7794 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7796 SUBROUTINE MATVEC2(A1,V1,V2)
7797 implicit real*8 (a-h,o-z)
7798 include 'DIMENSIONS'
7799 DIMENSION A1(2,2),V1(2),V2(2)
7803 c 3 VI=VI+A1(I,K)*V1(K)
7807 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7808 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7813 C---------------------------------------
7814 SUBROUTINE MATMAT2(A1,A2,A3)
7815 implicit real*8 (a-h,o-z)
7816 include 'DIMENSIONS'
7817 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7818 c DIMENSION AI3(2,2)
7822 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7828 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7829 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7830 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7831 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7839 c-------------------------------------------------------------------------
7840 double precision function scalar2(u,v)
7842 double precision u(2),v(2)
7845 scalar2=u(1)*v(1)+u(2)*v(2)
7849 C-----------------------------------------------------------------------------
7851 subroutine transpose2(a,at)
7853 double precision a(2,2),at(2,2)
7860 c--------------------------------------------------------------------------
7861 subroutine transpose(n,a,at)
7864 double precision a(n,n),at(n,n)
7872 C---------------------------------------------------------------------------
7873 subroutine prodmat3(a1,a2,kk,transp,prod)
7876 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7878 crc double precision auxmat(2,2),prod_(2,2)
7881 crc call transpose2(kk(1,1),auxmat(1,1))
7882 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7883 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7885 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7886 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7887 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7888 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7889 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7890 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7891 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7892 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7895 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7896 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7898 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7899 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7900 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7901 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7902 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7903 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7904 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7905 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7908 c call transpose2(a2(1,1),a2t(1,1))
7911 crc print *,((prod_(i,j),i=1,2),j=1,2)
7912 crc print *,((prod(i,j),i=1,2),j=1,2)
7916 C-----------------------------------------------------------------------------
7917 double precision function scalar(u,v)
7919 double precision u(3),v(3)
7929 C-----------------------------------------------------------------------
7930 double precision function sscale(r)
7931 double precision r,gamm
7932 include "COMMON.SPLITELE"
7933 if(r.lt.r_cut-rlamb) then
7935 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7936 gamm=(r-(r_cut-rlamb))/rlamb
7937 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
7943 C-----------------------------------------------------------------------
7944 C-----------------------------------------------------------------------
7945 double precision function sscagrad(r)
7946 double precision r,gamm
7947 include "COMMON.SPLITELE"
7948 if(r.lt.r_cut-rlamb) then
7950 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7951 gamm=(r-(r_cut-rlamb))/rlamb
7952 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
7958 C-----------------------------------------------------------------------
7959 C-----------------------------------------------------------------------
7960 double precision function sscalelip(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 sscalelip=1.0d0+r*r*(2*r-3.0d0)
7973 C-----------------------------------------------------------------------
7974 double precision function sscagradlip(r)
7975 double precision r,gamm
7976 include "COMMON.SPLITELE"
7977 C if(r.lt.r_cut-rlamb) then
7979 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7980 C gamm=(r-(r_cut-rlamb))/rlamb
7981 sscagradlip=r*(6*r-6.0d0)
7988 C-----------------------------------------------------------------------