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 include 'COMMON.CONTROL'
26 double precision fact(6)
27 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
28 cd print *,'nnt=',nnt,' nct=',nct
30 C Compute the side-chain and electrostatic interaction energy
32 goto (101,102,103,104,105) ipot
33 C Lennard-Jones potential.
34 101 call elj(evdw,evdw_t)
35 cd print '(a)','Exit ELJ'
37 C Lennard-Jones-Kihara potential (shifted).
38 102 call eljk(evdw,evdw_t)
40 C Berne-Pechukas potential (dilated LJ, angular dependence).
41 103 call ebp(evdw,evdw_t)
43 C Gay-Berne potential (shifted LJ, angular dependence).
44 104 call egb(evdw,evdw_t)
46 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
47 105 call egbv(evdw,evdw_t)
49 C Calculate electrostatic (H-bonding) energy of the main chain.
51 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
53 C Calculate excluded-volume interaction energy between peptide groups
56 call escp(evdw2,evdw2_14)
58 c Calculate the bond-stretching energy
61 c write (iout,*) "estr",estr
63 C Calculate the disulfide-bridge and other energy and the contributions
64 C from other distance constraints.
65 cd print *,'Calling EHPB'
67 cd print *,'EHPB exitted succesfully.'
69 C Calculate the virtual-bond-angle energy.
72 cd print *,'Bend energy finished.'
74 C Calculate the SC local energy.
77 cd print *,'SCLOC energy finished.'
79 C Calculate the virtual-bond torsional energy.
81 cd print *,'nterm=',nterm
82 call etor(etors,edihcnstr,fact(1))
84 C 6/23/01 Calculate double-torsional energy
86 call etor_d(etors_d,fact(2))
88 C 21/5/07 Calculate local sicdechain correlation energy
90 call eback_sc_corr(esccor)
92 C 12/1/95 Multi-body terms
96 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
97 & .or. wturn6.gt.0.0d0) then
98 c print *,"calling multibody_eello"
99 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
100 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
101 c print *,ecorr,ecorr5,ecorr6,eturn6
103 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
104 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
108 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
109 if (constr_homology.ge.1) then
110 call e_modeller(ehomology_constr)
112 ehomology_constr=0.0d0
115 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
117 C BARTEK for dfa test!
118 if (wdfa_dist.gt.0) call edfad(edfadis)
119 write(iout,*)'edfad is finished!', wdfa_dist,edfadis
120 if (wdfa_tor.gt.0) call edfat(edfator)
121 write(iout,*)'edfat is finished!', wdfa_tor,edfator
122 if (wdfa_nei.gt.0) call edfan(edfanei)
123 write(iout,*)'edfan is finished!', wdfa_nei,edfanei
124 if (wdfa_beta.gt.0) call edfab(edfabet)
125 write(iout,*)'edfab is finished!', wdfa_beta,edfabet
127 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
129 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
131 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
132 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
133 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
134 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
135 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
136 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
137 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
140 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
141 & +welec*fact(1)*(ees+evdw1)
142 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
143 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
144 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
145 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
146 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
147 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
148 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
154 energia(2)=evdw2-evdw2_14
171 energia(8)=eello_turn3
172 energia(9)=eello_turn4
181 energia(20)=edihcnstr
183 energia(22)=ehomology_constr
188 c if (dyn_ss) call dyn_set_nss
192 if (isnan(etot).ne.0) energia(0)=1.0d+99
194 if (isnan(etot)) energia(0)=1.0d+99
199 idumm=proc_proc(etot,i)
201 call proc_proc(etot,i)
203 if(i.eq.1)energia(0)=1.0d+99
210 C Sum up the components of the Cartesian gradient.
215 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
216 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
218 & wstrain*ghpbc(j,i)+
219 & wcorr*fact(3)*gradcorr(j,i)+
220 & wel_loc*fact(2)*gel_loc(j,i)+
221 & wturn3*fact(2)*gcorr3_turn(j,i)+
222 & wturn4*fact(3)*gcorr4_turn(j,i)+
223 & wcorr5*fact(4)*gradcorr5(j,i)+
224 & wcorr6*fact(5)*gradcorr6(j,i)+
225 & wturn6*fact(5)*gcorr6_turn(j,i)+
226 & wsccor*fact(2)*gsccorc(j,i)+
227 & wdfa_dist*gdfad(j,i)+
228 & wdfa_tor*gdfat(j,i)+
229 & wdfa_nei*gdfan(j,i)+
230 & wdfa_beta*gdfab(j,i)
231 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
233 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
234 & wsccor*fact(2)*gsccorx(j,i)
239 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
240 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
242 & wcorr*fact(3)*gradcorr(j,i)+
243 & wel_loc*fact(2)*gel_loc(j,i)+
244 & wturn3*fact(2)*gcorr3_turn(j,i)+
245 & wturn4*fact(3)*gcorr4_turn(j,i)+
246 & wcorr5*fact(4)*gradcorr5(j,i)+
247 & wcorr6*fact(5)*gradcorr6(j,i)+
248 & wturn6*fact(5)*gcorr6_turn(j,i)+
249 & wsccor*fact(2)*gsccorc(j,i)+
250 & wdfa_dist*gdfad(j,i)+
251 & wdfa_tor*gdfat(j,i)+
252 & wdfa_nei*gdfan(j,i)+
253 & wdfa_beta*gdfab(j,i)
254 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
256 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
257 & wsccor*fact(1)*gsccorx(j,i)
264 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
265 & +wcorr5*fact(4)*g_corr5_loc(i)
266 & +wcorr6*fact(5)*g_corr6_loc(i)
267 & +wturn4*fact(3)*gel_loc_turn4(i)
268 & +wturn3*fact(2)*gel_loc_turn3(i)
269 & +wturn6*fact(5)*gel_loc_turn6(i)
270 & +wel_loc*fact(2)*gel_loc_loc(i)
271 & +wsccor*fact(1)*gsccor_loc(i)
276 C------------------------------------------------------------------------
277 subroutine enerprint(energia,fact)
278 implicit real*8 (a-h,o-z)
280 include 'DIMENSIONS.ZSCOPT'
281 include 'COMMON.IOUNITS'
282 include 'COMMON.FFIELD'
283 include 'COMMON.SBRIDGE'
284 double precision energia(0:max_ene),fact(6)
286 evdw=energia(1)+fact(6)*energia(21)
288 evdw2=energia(2)+energia(17)
300 eello_turn3=energia(8)
301 eello_turn4=energia(9)
302 eello_turn6=energia(10)
309 edihcnstr=energia(20)
311 ehomology_constr=energia(22)
317 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
319 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
320 & etors_d,wtor_d*fact(2),ehpb,wstrain,
321 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
322 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
323 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
324 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,
325 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
327 10 format (/'Virtual-chain energies:'//
328 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
329 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
330 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
331 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
332 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
333 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
334 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
335 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
336 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
337 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
338 & ' (SS bridges & dist. cnstr.)'/
339 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
340 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
341 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
342 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
343 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
344 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
345 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
346 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
347 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
348 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
349 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
350 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
351 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
352 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
353 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
354 & 'ETOT= ',1pE16.6,' (total)')
356 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
357 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
358 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
359 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
360 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
361 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
362 & edihcnstr,ehomology_constr,ebr*nss,
363 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
365 10 format (/'Virtual-chain energies:'//
366 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
367 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
368 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
369 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
370 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
371 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
372 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
373 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
374 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
375 & ' (SS bridges & dist. cnstr.)'/
376 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
377 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
378 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
379 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
380 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
381 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
382 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
383 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
384 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
385 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
386 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
387 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
388 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
389 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
390 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
391 & 'ETOT= ',1pE16.6,' (total)')
395 C-----------------------------------------------------------------------
396 subroutine elj(evdw,evdw_t)
398 C This subroutine calculates the interaction energy of nonbonded side chains
399 C assuming the LJ potential of interaction.
401 implicit real*8 (a-h,o-z)
403 include 'DIMENSIONS.ZSCOPT'
404 include "DIMENSIONS.COMPAR"
405 parameter (accur=1.0d-10)
408 include 'COMMON.LOCAL'
409 include 'COMMON.CHAIN'
410 include 'COMMON.DERIV'
411 include 'COMMON.INTERACT'
412 include 'COMMON.TORSION'
413 include 'COMMON.ENEPS'
414 include 'COMMON.SBRIDGE'
415 include 'COMMON.NAMES'
416 include 'COMMON.IOUNITS'
417 include 'COMMON.CONTACTS'
421 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
424 eneps_temp(j,i)=0.0d0
438 C Calculate SC interaction energy.
441 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
442 cd & 'iend=',iend(i,iint)
443 do j=istart(i,iint),iend(i,iint)
448 C Change 12/1/95 to calculate four-body interactions
449 rij=xj*xj+yj*yj+zj*zj
451 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
452 eps0ij=eps(itypi,itypj)
454 e1=fac*fac*aa(itypi,itypj)
455 e2=fac*bb(itypi,itypj)
457 ij=icant(itypi,itypj)
458 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
459 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
460 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
461 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
462 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
463 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
464 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
465 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
466 if (bb(itypi,itypj).gt.0.0d0) then
473 C Calculate the components of the gradient in DC and X
475 fac=-rrij*(e1+evdwij)
480 gvdwx(k,i)=gvdwx(k,i)-gg(k)
481 gvdwx(k,j)=gvdwx(k,j)+gg(k)
485 gvdwc(l,k)=gvdwc(l,k)+gg(l)
490 C 12/1/95, revised on 5/20/97
492 C Calculate the contact function. The ith column of the array JCONT will
493 C contain the numbers of atoms that make contacts with the atom I (of numbers
494 C greater than I). The arrays FACONT and GACONT will contain the values of
495 C the contact function and its derivative.
497 C Uncomment next line, if the correlation interactions include EVDW explicitly.
498 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
499 C Uncomment next line, if the correlation interactions are contact function only
500 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
502 sigij=sigma(itypi,itypj)
503 r0ij=rs0(itypi,itypj)
505 C Check whether the SC's are not too far to make a contact.
508 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
509 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
511 if (fcont.gt.0.0D0) then
512 C If the SC-SC distance if close to sigma, apply spline.
513 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
514 cAdam & fcont1,fprimcont1)
515 cAdam fcont1=1.0d0-fcont1
516 cAdam if (fcont1.gt.0.0d0) then
517 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
518 cAdam fcont=fcont*fcont1
520 C Uncomment following 4 lines to have the geometric average of the epsilon0's
521 cga eps0ij=1.0d0/dsqrt(eps0ij)
523 cga gg(k)=gg(k)*eps0ij
525 cga eps0ij=-evdwij*eps0ij
526 C Uncomment for AL's type of SC correlation interactions.
528 num_conti=num_conti+1
530 facont(num_conti,i)=fcont*eps0ij
531 fprimcont=eps0ij*fprimcont/rij
533 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
534 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
535 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
536 C Uncomment following 3 lines for Skolnick's type of SC correlation.
537 gacont(1,num_conti,i)=-fprimcont*xj
538 gacont(2,num_conti,i)=-fprimcont*yj
539 gacont(3,num_conti,i)=-fprimcont*zj
540 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
541 cd write (iout,'(2i3,3f10.5)')
542 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
548 num_cont(i)=num_conti
553 gvdwc(j,i)=expon*gvdwc(j,i)
554 gvdwx(j,i)=expon*gvdwx(j,i)
558 C******************************************************************************
562 C To save time, the factor of EXPON has been extracted from ALL components
563 C of GVDWC and GRADX. Remember to multiply them by this factor before further
566 C******************************************************************************
569 C-----------------------------------------------------------------------------
570 subroutine eljk(evdw,evdw_t)
572 C This subroutine calculates the interaction energy of nonbonded side chains
573 C assuming the LJK potential of interaction.
575 implicit real*8 (a-h,o-z)
577 include 'DIMENSIONS.ZSCOPT'
578 include "DIMENSIONS.COMPAR"
581 include 'COMMON.LOCAL'
582 include 'COMMON.CHAIN'
583 include 'COMMON.DERIV'
584 include 'COMMON.INTERACT'
585 include 'COMMON.ENEPS'
586 include 'COMMON.IOUNITS'
587 include 'COMMON.NAMES'
592 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
595 eneps_temp(j,i)=0.0d0
607 C Calculate SC interaction energy.
610 do j=istart(i,iint),iend(i,iint)
615 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
617 e_augm=augm(itypi,itypj)*fac_augm
620 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
621 fac=r_shift_inv**expon
622 e1=fac*fac*aa(itypi,itypj)
623 e2=fac*bb(itypi,itypj)
625 ij=icant(itypi,itypj)
626 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
627 & /dabs(eps(itypi,itypj))
628 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
629 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
630 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
631 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
632 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
633 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
634 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
635 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
636 if (bb(itypi,itypj).gt.0.0d0) then
643 C Calculate the components of the gradient in DC and X
645 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
650 gvdwx(k,i)=gvdwx(k,i)-gg(k)
651 gvdwx(k,j)=gvdwx(k,j)+gg(k)
655 gvdwc(l,k)=gvdwc(l,k)+gg(l)
665 gvdwc(j,i)=expon*gvdwc(j,i)
666 gvdwx(j,i)=expon*gvdwx(j,i)
672 C-----------------------------------------------------------------------------
673 subroutine ebp(evdw,evdw_t)
675 C This subroutine calculates the interaction energy of nonbonded side chains
676 C assuming the Berne-Pechukas potential of interaction.
678 implicit real*8 (a-h,o-z)
680 include 'DIMENSIONS.ZSCOPT'
681 include "DIMENSIONS.COMPAR"
684 include 'COMMON.LOCAL'
685 include 'COMMON.CHAIN'
686 include 'COMMON.DERIV'
687 include 'COMMON.NAMES'
688 include 'COMMON.INTERACT'
689 include 'COMMON.ENEPS'
690 include 'COMMON.IOUNITS'
691 include 'COMMON.CALC'
693 c double precision rrsave(maxdim)
699 eneps_temp(j,i)=0.0d0
704 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
705 c if (icall.eq.0) then
717 dxi=dc_norm(1,nres+i)
718 dyi=dc_norm(2,nres+i)
719 dzi=dc_norm(3,nres+i)
720 dsci_inv=vbld_inv(i+nres)
722 C Calculate SC interaction energy.
725 do j=istart(i,iint),iend(i,iint)
728 dscj_inv=vbld_inv(j+nres)
729 chi1=chi(itypi,itypj)
730 chi2=chi(itypj,itypi)
737 alf12=0.5D0*(alf1+alf2)
738 C For diagnostics only!!!
751 dxj=dc_norm(1,nres+j)
752 dyj=dc_norm(2,nres+j)
753 dzj=dc_norm(3,nres+j)
754 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
755 cd if (icall.eq.0) then
761 C Calculate the angle-dependent terms of energy & contributions to derivatives.
763 C Calculate whole angle-dependent part of epsilon and contributions
765 fac=(rrij*sigsq)**expon2
766 e1=fac*fac*aa(itypi,itypj)
767 e2=fac*bb(itypi,itypj)
768 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
769 eps2der=evdwij*eps3rt
770 eps3der=evdwij*eps2rt
771 evdwij=evdwij*eps2rt*eps3rt
772 ij=icant(itypi,itypj)
773 aux=eps1*eps2rt**2*eps3rt**2
774 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
775 & /dabs(eps(itypi,itypj))
776 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
777 if (bb(itypi,itypj).gt.0.0d0) then
784 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
785 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
786 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
787 cd & restyp(itypi),i,restyp(itypj),j,
788 cd & epsi,sigm,chi1,chi2,chip1,chip2,
789 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
790 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
793 C Calculate gradient components.
794 e1=e1*eps1*eps2rt**2*eps3rt**2
795 fac=-expon*(e1+evdwij)
798 C Calculate radial part of the gradient
802 C Calculate the angular part of the gradient and sum add the contributions
803 C to the appropriate components of the Cartesian gradient.
812 C-----------------------------------------------------------------------------
813 subroutine egb(evdw,evdw_t)
815 C This subroutine calculates the interaction energy of nonbonded side chains
816 C assuming the Gay-Berne potential of interaction.
818 implicit real*8 (a-h,o-z)
820 include 'DIMENSIONS.ZSCOPT'
821 include "DIMENSIONS.COMPAR"
824 include 'COMMON.LOCAL'
825 include 'COMMON.CHAIN'
826 include 'COMMON.DERIV'
827 include 'COMMON.NAMES'
828 include 'COMMON.INTERACT'
829 include 'COMMON.ENEPS'
830 include 'COMMON.IOUNITS'
831 include 'COMMON.CALC'
832 include 'COMMON.SBRIDGE'
839 eneps_temp(j,i)=0.0d0
842 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
846 c if (icall.gt.0) lprn=.true.
854 dxi=dc_norm(1,nres+i)
855 dyi=dc_norm(2,nres+i)
856 dzi=dc_norm(3,nres+i)
857 dsci_inv=vbld_inv(i+nres)
859 C Calculate SC interaction energy.
862 do j=istart(i,iint),iend(i,iint)
863 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
864 C /06/28/2013 Adasko: In case of dyn_ss - dynamic disulfide bond
865 C formation no electrostatic interactions should be calculated. If it
866 C would be allowed NaN would appear
867 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
868 C /06/28/2013 Adasko: dyn_ss_mask is logical statement wheather this Cys
869 C residue can or cannot form disulfide bond. There is still bug allowing
870 C Cys...Cys...Cys bond formation
871 call dyn_ssbond_ene(i,j,evdwij)
872 C /06/28/2013 Adasko: dyn_ssbond_ene is dynamic SS bond foration energy
875 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
876 c & 'evdw',i,j,evdwij,' ss'
880 dscj_inv=vbld_inv(j+nres)
881 sig0ij=sigma(itypi,itypj)
882 chi1=chi(itypi,itypj)
883 chi2=chi(itypj,itypi)
890 alf12=0.5D0*(alf1+alf2)
891 C For diagnostics only!!!
904 dxj=dc_norm(1,nres+j)
905 dyj=dc_norm(2,nres+j)
906 dzj=dc_norm(3,nres+j)
907 c write (iout,*) i,j,xj,yj,zj
908 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
910 C Calculate angle-dependent terms of energy and contributions to their
914 sig=sig0ij*dsqrt(sigsq)
915 rij_shift=1.0D0/rij-sig+sig0ij
916 C I hate to put IF's in the loops, but here don't have another choice!!!!
917 if (rij_shift.le.0.0D0) then
922 c---------------------------------------------------------------
923 rij_shift=1.0D0/rij_shift
925 e1=fac*fac*aa(itypi,itypj)
926 e2=fac*bb(itypi,itypj)
927 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
928 eps2der=evdwij*eps3rt
929 eps3der=evdwij*eps2rt
930 evdwij=evdwij*eps2rt*eps3rt
931 if (bb(itypi,itypj).gt.0) then
936 ij=icant(itypi,itypj)
937 aux=eps1*eps2rt**2*eps3rt**2
938 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
939 & /dabs(eps(itypi,itypj))
940 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
941 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
942 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
943 c & aux*e2/eps(itypi,itypj)
944 c write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
946 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
947 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
948 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
949 & restyp(itypi),i,restyp(itypj),j,
950 & epsi,sigm,chi1,chi2,chip1,chip2,
951 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
952 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
956 C Calculate gradient components.
957 e1=e1*eps1*eps2rt**2*eps3rt**2
958 fac=-expon*(e1+evdwij)*rij_shift
961 C Calculate the radial part of the gradient
965 C Calculate angular part of the gradient.
974 C-----------------------------------------------------------------------------
975 subroutine egbv(evdw,evdw_t)
977 C This subroutine calculates the interaction energy of nonbonded side chains
978 C assuming the Gay-Berne-Vorobjev potential of interaction.
980 implicit real*8 (a-h,o-z)
982 include 'DIMENSIONS.ZSCOPT'
983 include "DIMENSIONS.COMPAR"
986 include 'COMMON.LOCAL'
987 include 'COMMON.CHAIN'
988 include 'COMMON.DERIV'
989 include 'COMMON.NAMES'
990 include 'COMMON.INTERACT'
991 include 'COMMON.ENEPS'
992 include 'COMMON.IOUNITS'
993 include 'COMMON.CALC'
1000 eneps_temp(j,i)=0.0d0
1005 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1008 c if (icall.gt.0) lprn=.true.
1010 do i=iatsc_s,iatsc_e
1016 dxi=dc_norm(1,nres+i)
1017 dyi=dc_norm(2,nres+i)
1018 dzi=dc_norm(3,nres+i)
1019 dsci_inv=vbld_inv(i+nres)
1021 C Calculate SC interaction energy.
1023 do iint=1,nint_gr(i)
1024 do j=istart(i,iint),iend(i,iint)
1027 dscj_inv=vbld_inv(j+nres)
1028 sig0ij=sigma(itypi,itypj)
1029 r0ij=r0(itypi,itypj)
1030 chi1=chi(itypi,itypj)
1031 chi2=chi(itypj,itypi)
1038 alf12=0.5D0*(alf1+alf2)
1039 C For diagnostics only!!!
1052 dxj=dc_norm(1,nres+j)
1053 dyj=dc_norm(2,nres+j)
1054 dzj=dc_norm(3,nres+j)
1055 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1057 C Calculate angle-dependent terms of energy and contributions to their
1061 sig=sig0ij*dsqrt(sigsq)
1062 rij_shift=1.0D0/rij-sig+r0ij
1063 C I hate to put IF's in the loops, but here don't have another choice!!!!
1064 if (rij_shift.le.0.0D0) then
1069 c---------------------------------------------------------------
1070 rij_shift=1.0D0/rij_shift
1071 fac=rij_shift**expon
1072 e1=fac*fac*aa(itypi,itypj)
1073 e2=fac*bb(itypi,itypj)
1074 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1075 eps2der=evdwij*eps3rt
1076 eps3der=evdwij*eps2rt
1077 fac_augm=rrij**expon
1078 e_augm=augm(itypi,itypj)*fac_augm
1079 evdwij=evdwij*eps2rt*eps3rt
1080 if (bb(itypi,itypj).gt.0.0d0) then
1081 evdw=evdw+evdwij+e_augm
1083 evdw_t=evdw_t+evdwij+e_augm
1085 ij=icant(itypi,itypj)
1086 aux=eps1*eps2rt**2*eps3rt**2
1087 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1088 & /dabs(eps(itypi,itypj))
1089 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1090 c eneps_temp(ij)=eneps_temp(ij)
1091 c & +(evdwij+e_augm)/eps(itypi,itypj)
1093 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1094 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1095 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1096 c & restyp(itypi),i,restyp(itypj),j,
1097 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1098 c & chi1,chi2,chip1,chip2,
1099 c & eps1,eps2rt**2,eps3rt**2,
1100 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1104 C Calculate gradient components.
1105 e1=e1*eps1*eps2rt**2*eps3rt**2
1106 fac=-expon*(e1+evdwij)*rij_shift
1108 fac=rij*fac-2*expon*rrij*e_augm
1109 C Calculate the radial part of the gradient
1113 C Calculate angular part of the gradient.
1121 C-----------------------------------------------------------------------------
1122 subroutine sc_angular
1123 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1124 C om12. Called by ebp, egb, and egbv.
1126 include 'COMMON.CALC'
1130 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1131 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1132 om12=dxi*dxj+dyi*dyj+dzi*dzj
1134 C Calculate eps1(om12) and its derivative in om12
1135 faceps1=1.0D0-om12*chiom12
1136 faceps1_inv=1.0D0/faceps1
1137 eps1=dsqrt(faceps1_inv)
1138 C Following variable is eps1*deps1/dom12
1139 eps1_om12=faceps1_inv*chiom12
1140 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1145 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1146 sigsq=1.0D0-facsig*faceps1_inv
1147 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1148 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1149 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1150 C Calculate eps2 and its derivatives in om1, om2, and om12.
1153 chipom12=chip12*om12
1154 facp=1.0D0-om12*chipom12
1156 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1157 C Following variable is the square root of eps2
1158 eps2rt=1.0D0-facp1*facp_inv
1159 C Following three variables are the derivatives of the square root of eps
1160 C in om1, om2, and om12.
1161 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1162 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1163 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1164 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1165 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1166 C Calculate whole angle-dependent part of epsilon and contributions
1167 C to its derivatives
1170 C----------------------------------------------------------------------------
1172 implicit real*8 (a-h,o-z)
1173 include 'DIMENSIONS'
1174 include 'DIMENSIONS.ZSCOPT'
1175 include 'COMMON.CHAIN'
1176 include 'COMMON.DERIV'
1177 include 'COMMON.CALC'
1178 double precision dcosom1(3),dcosom2(3)
1179 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1180 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1181 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1182 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1184 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1185 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1188 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1191 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1192 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1193 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1194 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1195 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1196 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1199 C Calculate the components of the gradient in DC and X
1203 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1208 c------------------------------------------------------------------------------
1209 subroutine vec_and_deriv
1210 implicit real*8 (a-h,o-z)
1211 include 'DIMENSIONS'
1212 include 'DIMENSIONS.ZSCOPT'
1213 include 'COMMON.IOUNITS'
1214 include 'COMMON.GEO'
1215 include 'COMMON.VAR'
1216 include 'COMMON.LOCAL'
1217 include 'COMMON.CHAIN'
1218 include 'COMMON.VECTORS'
1219 include 'COMMON.DERIV'
1220 include 'COMMON.INTERACT'
1221 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1222 C Compute the local reference systems. For reference system (i), the
1223 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1224 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1226 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1227 if (i.eq.nres-1) then
1228 C Case of the last full residue
1229 C Compute the Z-axis
1230 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1231 costh=dcos(pi-theta(nres))
1232 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1237 C Compute the derivatives of uz
1239 uzder(2,1,1)=-dc_norm(3,i-1)
1240 uzder(3,1,1)= dc_norm(2,i-1)
1241 uzder(1,2,1)= dc_norm(3,i-1)
1243 uzder(3,2,1)=-dc_norm(1,i-1)
1244 uzder(1,3,1)=-dc_norm(2,i-1)
1245 uzder(2,3,1)= dc_norm(1,i-1)
1248 uzder(2,1,2)= dc_norm(3,i)
1249 uzder(3,1,2)=-dc_norm(2,i)
1250 uzder(1,2,2)=-dc_norm(3,i)
1252 uzder(3,2,2)= dc_norm(1,i)
1253 uzder(1,3,2)= dc_norm(2,i)
1254 uzder(2,3,2)=-dc_norm(1,i)
1257 C Compute the Y-axis
1260 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1263 C Compute the derivatives of uy
1266 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1267 & -dc_norm(k,i)*dc_norm(j,i-1)
1268 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1270 uyder(j,j,1)=uyder(j,j,1)-costh
1271 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1276 uygrad(l,k,j,i)=uyder(l,k,j)
1277 uzgrad(l,k,j,i)=uzder(l,k,j)
1281 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1282 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1283 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1284 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1288 C Compute the Z-axis
1289 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1290 costh=dcos(pi-theta(i+2))
1291 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1296 C Compute the derivatives of uz
1298 uzder(2,1,1)=-dc_norm(3,i+1)
1299 uzder(3,1,1)= dc_norm(2,i+1)
1300 uzder(1,2,1)= dc_norm(3,i+1)
1302 uzder(3,2,1)=-dc_norm(1,i+1)
1303 uzder(1,3,1)=-dc_norm(2,i+1)
1304 uzder(2,3,1)= dc_norm(1,i+1)
1307 uzder(2,1,2)= dc_norm(3,i)
1308 uzder(3,1,2)=-dc_norm(2,i)
1309 uzder(1,2,2)=-dc_norm(3,i)
1311 uzder(3,2,2)= dc_norm(1,i)
1312 uzder(1,3,2)= dc_norm(2,i)
1313 uzder(2,3,2)=-dc_norm(1,i)
1316 C Compute the Y-axis
1319 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1322 C Compute the derivatives of uy
1325 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1326 & -dc_norm(k,i)*dc_norm(j,i+1)
1327 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1329 uyder(j,j,1)=uyder(j,j,1)-costh
1330 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1335 uygrad(l,k,j,i)=uyder(l,k,j)
1336 uzgrad(l,k,j,i)=uzder(l,k,j)
1340 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1341 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1342 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1343 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1349 vbld_inv_temp(1)=vbld_inv(i+1)
1350 if (i.lt.nres-1) then
1351 vbld_inv_temp(2)=vbld_inv(i+2)
1353 vbld_inv_temp(2)=vbld_inv(i)
1358 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1359 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1367 C-----------------------------------------------------------------------------
1368 subroutine vec_and_deriv_test
1369 implicit real*8 (a-h,o-z)
1370 include 'DIMENSIONS'
1371 include 'DIMENSIONS.ZSCOPT'
1372 include 'COMMON.IOUNITS'
1373 include 'COMMON.GEO'
1374 include 'COMMON.VAR'
1375 include 'COMMON.LOCAL'
1376 include 'COMMON.CHAIN'
1377 include 'COMMON.VECTORS'
1378 dimension uyder(3,3,2),uzder(3,3,2)
1379 C Compute the local reference systems. For reference system (i), the
1380 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1381 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1383 if (i.eq.nres-1) then
1384 C Case of the last full residue
1385 C Compute the Z-axis
1386 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1387 costh=dcos(pi-theta(nres))
1388 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1389 c write (iout,*) 'fac',fac,
1390 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1391 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1395 C Compute the derivatives of uz
1397 uzder(2,1,1)=-dc_norm(3,i-1)
1398 uzder(3,1,1)= dc_norm(2,i-1)
1399 uzder(1,2,1)= dc_norm(3,i-1)
1401 uzder(3,2,1)=-dc_norm(1,i-1)
1402 uzder(1,3,1)=-dc_norm(2,i-1)
1403 uzder(2,3,1)= dc_norm(1,i-1)
1406 uzder(2,1,2)= dc_norm(3,i)
1407 uzder(3,1,2)=-dc_norm(2,i)
1408 uzder(1,2,2)=-dc_norm(3,i)
1410 uzder(3,2,2)= dc_norm(1,i)
1411 uzder(1,3,2)= dc_norm(2,i)
1412 uzder(2,3,2)=-dc_norm(1,i)
1414 C Compute the Y-axis
1416 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1419 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1420 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1421 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1423 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1426 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1427 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1430 c write (iout,*) 'facy',facy,
1431 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1432 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1434 uy(k,i)=facy*uy(k,i)
1436 C Compute the derivatives of uy
1439 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1440 & -dc_norm(k,i)*dc_norm(j,i-1)
1441 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1443 c uyder(j,j,1)=uyder(j,j,1)-costh
1444 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1445 uyder(j,j,1)=uyder(j,j,1)
1446 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1447 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1453 uygrad(l,k,j,i)=uyder(l,k,j)
1454 uzgrad(l,k,j,i)=uzder(l,k,j)
1458 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1459 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1460 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1461 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1464 C Compute the Z-axis
1465 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1466 costh=dcos(pi-theta(i+2))
1467 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1468 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1472 C Compute the derivatives of uz
1474 uzder(2,1,1)=-dc_norm(3,i+1)
1475 uzder(3,1,1)= dc_norm(2,i+1)
1476 uzder(1,2,1)= dc_norm(3,i+1)
1478 uzder(3,2,1)=-dc_norm(1,i+1)
1479 uzder(1,3,1)=-dc_norm(2,i+1)
1480 uzder(2,3,1)= dc_norm(1,i+1)
1483 uzder(2,1,2)= dc_norm(3,i)
1484 uzder(3,1,2)=-dc_norm(2,i)
1485 uzder(1,2,2)=-dc_norm(3,i)
1487 uzder(3,2,2)= dc_norm(1,i)
1488 uzder(1,3,2)= dc_norm(2,i)
1489 uzder(2,3,2)=-dc_norm(1,i)
1491 C Compute the Y-axis
1493 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1494 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1495 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1497 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1500 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1501 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1504 c write (iout,*) 'facy',facy,
1505 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1506 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1508 uy(k,i)=facy*uy(k,i)
1510 C Compute the derivatives of uy
1513 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1514 & -dc_norm(k,i)*dc_norm(j,i+1)
1515 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1517 c uyder(j,j,1)=uyder(j,j,1)-costh
1518 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1519 uyder(j,j,1)=uyder(j,j,1)
1520 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1521 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1527 uygrad(l,k,j,i)=uyder(l,k,j)
1528 uzgrad(l,k,j,i)=uzder(l,k,j)
1532 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1533 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1534 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1535 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1542 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1543 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1550 C-----------------------------------------------------------------------------
1551 subroutine check_vecgrad
1552 implicit real*8 (a-h,o-z)
1553 include 'DIMENSIONS'
1554 include 'DIMENSIONS.ZSCOPT'
1555 include 'COMMON.IOUNITS'
1556 include 'COMMON.GEO'
1557 include 'COMMON.VAR'
1558 include 'COMMON.LOCAL'
1559 include 'COMMON.CHAIN'
1560 include 'COMMON.VECTORS'
1561 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1562 dimension uyt(3,maxres),uzt(3,maxres)
1563 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1564 double precision delta /1.0d-7/
1567 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1568 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1569 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1570 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1571 cd & (dc_norm(if90,i),if90=1,3)
1572 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1573 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1574 cd write(iout,'(a)')
1580 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1581 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1594 cd write (iout,*) 'i=',i
1596 erij(k)=dc_norm(k,i)
1600 dc_norm(k,i)=erij(k)
1602 dc_norm(j,i)=dc_norm(j,i)+delta
1603 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1605 c dc_norm(k,i)=dc_norm(k,i)/fac
1607 c write (iout,*) (dc_norm(k,i),k=1,3)
1608 c write (iout,*) (erij(k),k=1,3)
1611 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1612 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1613 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1614 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1616 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1617 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1618 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1621 dc_norm(k,i)=erij(k)
1624 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1625 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1626 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1627 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1628 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1629 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1630 cd write (iout,'(a)')
1635 C--------------------------------------------------------------------------
1636 subroutine set_matrices
1637 implicit real*8 (a-h,o-z)
1638 include 'DIMENSIONS'
1639 include 'DIMENSIONS.ZSCOPT'
1640 include 'COMMON.IOUNITS'
1641 include 'COMMON.GEO'
1642 include 'COMMON.VAR'
1643 include 'COMMON.LOCAL'
1644 include 'COMMON.CHAIN'
1645 include 'COMMON.DERIV'
1646 include 'COMMON.INTERACT'
1647 include 'COMMON.CONTACTS'
1648 include 'COMMON.TORSION'
1649 include 'COMMON.VECTORS'
1650 include 'COMMON.FFIELD'
1651 double precision auxvec(2),auxmat(2,2)
1653 C Compute the virtual-bond-torsional-angle dependent quantities needed
1654 C to calculate the el-loc multibody terms of various order.
1657 if (i .lt. nres+1) then
1694 if (i .gt. 3 .and. i .lt. nres+1) then
1695 obrot_der(1,i-2)=-sin1
1696 obrot_der(2,i-2)= cos1
1697 Ugder(1,1,i-2)= sin1
1698 Ugder(1,2,i-2)=-cos1
1699 Ugder(2,1,i-2)=-cos1
1700 Ugder(2,2,i-2)=-sin1
1703 obrot2_der(1,i-2)=-dwasin2
1704 obrot2_der(2,i-2)= dwacos2
1705 Ug2der(1,1,i-2)= dwasin2
1706 Ug2der(1,2,i-2)=-dwacos2
1707 Ug2der(2,1,i-2)=-dwacos2
1708 Ug2der(2,2,i-2)=-dwasin2
1710 obrot_der(1,i-2)=0.0d0
1711 obrot_der(2,i-2)=0.0d0
1712 Ugder(1,1,i-2)=0.0d0
1713 Ugder(1,2,i-2)=0.0d0
1714 Ugder(2,1,i-2)=0.0d0
1715 Ugder(2,2,i-2)=0.0d0
1716 obrot2_der(1,i-2)=0.0d0
1717 obrot2_der(2,i-2)=0.0d0
1718 Ug2der(1,1,i-2)=0.0d0
1719 Ug2der(1,2,i-2)=0.0d0
1720 Ug2der(2,1,i-2)=0.0d0
1721 Ug2der(2,2,i-2)=0.0d0
1723 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1724 iti = itortyp(itype(i-2))
1728 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1729 iti1 = itortyp(itype(i-1))
1733 cd write (iout,*) '*******i',i,' iti1',iti
1734 cd write (iout,*) 'b1',b1(:,iti)
1735 cd write (iout,*) 'b2',b2(:,iti)
1736 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1737 if (i .gt. iatel_s+2) then
1738 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1739 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1740 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1741 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1742 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1743 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1744 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1754 DtUg2(l,k,i-2)=0.0d0
1758 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1759 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1760 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1761 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1762 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1763 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1764 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1766 muder(k,i-2)=Ub2der(k,i-2)
1768 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1769 iti1 = itortyp(itype(i-1))
1774 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1776 C Vectors and matrices dependent on a single virtual-bond dihedral.
1777 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1778 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1779 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1780 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1781 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1782 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1783 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1784 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1785 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1786 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1787 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1789 C Matrices dependent on two consecutive virtual-bond dihedrals.
1790 C The order of matrices is from left to right.
1792 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1793 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1794 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1795 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1796 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1797 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1798 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1799 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1802 cd iti = itortyp(itype(i))
1805 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1806 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1811 C--------------------------------------------------------------------------
1812 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1814 C This subroutine calculates the average interaction energy and its gradient
1815 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1816 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1817 C The potential depends both on the distance of peptide-group centers and on
1818 C the orientation of the CA-CA virtual bonds.
1820 implicit real*8 (a-h,o-z)
1821 include 'DIMENSIONS'
1822 include 'DIMENSIONS.ZSCOPT'
1823 include 'COMMON.CONTROL'
1824 include 'COMMON.IOUNITS'
1825 include 'COMMON.GEO'
1826 include 'COMMON.VAR'
1827 include 'COMMON.LOCAL'
1828 include 'COMMON.CHAIN'
1829 include 'COMMON.DERIV'
1830 include 'COMMON.INTERACT'
1831 include 'COMMON.CONTACTS'
1832 include 'COMMON.TORSION'
1833 include 'COMMON.VECTORS'
1834 include 'COMMON.FFIELD'
1835 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1836 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1837 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1838 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1839 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1840 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1841 double precision scal_el /0.5d0/
1843 C 13-go grudnia roku pamietnego...
1844 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1845 & 0.0d0,1.0d0,0.0d0,
1846 & 0.0d0,0.0d0,1.0d0/
1847 cd write(iout,*) 'In EELEC'
1849 cd write(iout,*) 'Type',i
1850 cd write(iout,*) 'B1',B1(:,i)
1851 cd write(iout,*) 'B2',B2(:,i)
1852 cd write(iout,*) 'CC',CC(:,:,i)
1853 cd write(iout,*) 'DD',DD(:,:,i)
1854 cd write(iout,*) 'EE',EE(:,:,i)
1856 cd call check_vecgrad
1858 if (icheckgrad.eq.1) then
1860 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1862 dc_norm(k,i)=dc(k,i)*fac
1864 c write (iout,*) 'i',i,' fac',fac
1867 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1868 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1869 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1870 cd if (wel_loc.gt.0.0d0) then
1871 if (icheckgrad.eq.1) then
1872 call vec_and_deriv_test
1879 cd write (iout,*) 'i=',i
1881 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1884 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1885 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1898 cd print '(a)','Enter EELEC'
1899 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1901 gel_loc_loc(i)=0.0d0
1904 do i=iatel_s,iatel_e
1905 if (itel(i).eq.0) goto 1215
1909 dx_normi=dc_norm(1,i)
1910 dy_normi=dc_norm(2,i)
1911 dz_normi=dc_norm(3,i)
1912 xmedi=c(1,i)+0.5d0*dxi
1913 ymedi=c(2,i)+0.5d0*dyi
1914 zmedi=c(3,i)+0.5d0*dzi
1916 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1917 do j=ielstart(i),ielend(i)
1918 if (itel(j).eq.0) goto 1216
1922 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1923 aaa=app(iteli,itelj)
1924 bbb=bpp(iteli,itelj)
1925 C Diagnostics only!!!
1931 ael6i=ael6(iteli,itelj)
1932 ael3i=ael3(iteli,itelj)
1936 dx_normj=dc_norm(1,j)
1937 dy_normj=dc_norm(2,j)
1938 dz_normj=dc_norm(3,j)
1939 xj=c(1,j)+0.5D0*dxj-xmedi
1940 yj=c(2,j)+0.5D0*dyj-ymedi
1941 zj=c(3,j)+0.5D0*dzj-zmedi
1942 rij=xj*xj+yj*yj+zj*zj
1948 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1949 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1950 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1951 fac=cosa-3.0D0*cosb*cosg
1953 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1954 if (j.eq.i+2) ev1=scal_el*ev1
1959 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1962 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1963 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1964 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1967 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1968 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1969 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1970 cd & xmedi,ymedi,zmedi,xj,yj,zj
1972 C Calculate contributions to the Cartesian gradient.
1975 facvdw=-6*rrmij*(ev1+evdwij)
1976 facel=-3*rrmij*(el1+eesij)
1983 * Radial derivatives. First process both termini of the fragment (i,j)
1990 gelc(k,i)=gelc(k,i)+ghalf
1991 gelc(k,j)=gelc(k,j)+ghalf
1994 * Loop over residues i+1 thru j-1.
1998 gelc(l,k)=gelc(l,k)+ggg(l)
2006 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2007 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2010 * Loop over residues i+1 thru j-1.
2014 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2021 fac=-3*rrmij*(facvdw+facvdw+facel)
2027 * Radial derivatives. First process both termini of the fragment (i,j)
2034 gelc(k,i)=gelc(k,i)+ghalf
2035 gelc(k,j)=gelc(k,j)+ghalf
2038 * Loop over residues i+1 thru j-1.
2042 gelc(l,k)=gelc(l,k)+ggg(l)
2049 ecosa=2.0D0*fac3*fac1+fac4
2052 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2053 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2055 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2056 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2058 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2059 cd & (dcosg(k),k=1,3)
2061 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2065 gelc(k,i)=gelc(k,i)+ghalf
2066 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2067 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2068 gelc(k,j)=gelc(k,j)+ghalf
2069 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2070 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2074 gelc(l,k)=gelc(l,k)+ggg(l)
2079 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2080 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2081 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2083 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2084 C energy of a peptide unit is assumed in the form of a second-order
2085 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2086 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2087 C are computed for EVERY pair of non-contiguous peptide groups.
2089 if (j.lt.nres-1) then
2100 muij(kkk)=mu(k,i)*mu(l,j)
2103 cd write (iout,*) 'EELEC: i',i,' j',j
2104 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2105 cd write(iout,*) 'muij',muij
2106 ury=scalar(uy(1,i),erij)
2107 urz=scalar(uz(1,i),erij)
2108 vry=scalar(uy(1,j),erij)
2109 vrz=scalar(uz(1,j),erij)
2110 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2111 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2112 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2113 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2114 C For diagnostics only
2119 fac=dsqrt(-ael6i)*r3ij
2120 cd write (2,*) 'fac=',fac
2121 C For diagnostics only
2127 cd write (iout,'(4i5,4f10.5)')
2128 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2129 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2130 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2131 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2132 cd write (iout,'(4f10.5)')
2133 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2134 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2135 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2136 cd write (iout,'(2i3,9f10.5/)') i,j,
2137 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2139 C Derivatives of the elements of A in virtual-bond vectors
2140 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2147 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2148 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2149 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2150 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2151 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2152 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2153 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2154 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2155 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2156 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2157 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2158 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2168 C Compute radial contributions to the gradient
2190 C Add the contributions coming from er
2193 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2194 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2195 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2196 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2199 C Derivatives in DC(i)
2200 ghalf1=0.5d0*agg(k,1)
2201 ghalf2=0.5d0*agg(k,2)
2202 ghalf3=0.5d0*agg(k,3)
2203 ghalf4=0.5d0*agg(k,4)
2204 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2205 & -3.0d0*uryg(k,2)*vry)+ghalf1
2206 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2207 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2208 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2209 & -3.0d0*urzg(k,2)*vry)+ghalf3
2210 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2211 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2212 C Derivatives in DC(i+1)
2213 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2214 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2215 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2216 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2217 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2218 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2219 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2220 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2221 C Derivatives in DC(j)
2222 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2223 & -3.0d0*vryg(k,2)*ury)+ghalf1
2224 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2225 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2226 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2227 & -3.0d0*vryg(k,2)*urz)+ghalf3
2228 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2229 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2230 C Derivatives in DC(j+1) or DC(nres-1)
2231 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2232 & -3.0d0*vryg(k,3)*ury)
2233 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2234 & -3.0d0*vrzg(k,3)*ury)
2235 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2236 & -3.0d0*vryg(k,3)*urz)
2237 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2238 & -3.0d0*vrzg(k,3)*urz)
2243 C Derivatives in DC(i+1)
2244 cd aggi1(k,1)=agg(k,1)
2245 cd aggi1(k,2)=agg(k,2)
2246 cd aggi1(k,3)=agg(k,3)
2247 cd aggi1(k,4)=agg(k,4)
2248 C Derivatives in DC(j)
2253 C Derivatives in DC(j+1)
2258 if (j.eq.nres-1 .and. i.lt.j-2) then
2260 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2261 cd aggj1(k,l)=agg(k,l)
2267 C Check the loc-el terms by numerical integration
2277 aggi(k,l)=-aggi(k,l)
2278 aggi1(k,l)=-aggi1(k,l)
2279 aggj(k,l)=-aggj(k,l)
2280 aggj1(k,l)=-aggj1(k,l)
2283 if (j.lt.nres-1) then
2289 aggi(k,l)=-aggi(k,l)
2290 aggi1(k,l)=-aggi1(k,l)
2291 aggj(k,l)=-aggj(k,l)
2292 aggj1(k,l)=-aggj1(k,l)
2303 aggi(k,l)=-aggi(k,l)
2304 aggi1(k,l)=-aggi1(k,l)
2305 aggj(k,l)=-aggj(k,l)
2306 aggj1(k,l)=-aggj1(k,l)
2312 IF (wel_loc.gt.0.0d0) THEN
2313 C Contribution to the local-electrostatic energy coming from the i-j pair
2314 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2316 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2317 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2318 eel_loc=eel_loc+eel_loc_ij
2319 C Partial derivatives in virtual-bond dihedral angles gamma
2322 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2323 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2324 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2325 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2326 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2327 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2328 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2329 cd write(iout,*) 'agg ',agg
2330 cd write(iout,*) 'aggi ',aggi
2331 cd write(iout,*) 'aggi1',aggi1
2332 cd write(iout,*) 'aggj ',aggj
2333 cd write(iout,*) 'aggj1',aggj1
2335 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2337 ggg(l)=agg(l,1)*muij(1)+
2338 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2342 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2345 C Remaining derivatives of eello
2347 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2348 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2349 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2350 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2351 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2352 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2353 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2354 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2358 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2359 C Contributions from turns
2364 call eturn34(i,j,eello_turn3,eello_turn4)
2366 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2367 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2369 C Calculate the contact function. The ith column of the array JCONT will
2370 C contain the numbers of atoms that make contacts with the atom I (of numbers
2371 C greater than I). The arrays FACONT and GACONT will contain the values of
2372 C the contact function and its derivative.
2373 c r0ij=1.02D0*rpp(iteli,itelj)
2374 c r0ij=1.11D0*rpp(iteli,itelj)
2375 r0ij=2.20D0*rpp(iteli,itelj)
2376 c r0ij=1.55D0*rpp(iteli,itelj)
2377 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2378 if (fcont.gt.0.0D0) then
2379 num_conti=num_conti+1
2380 if (num_conti.gt.maxconts) then
2381 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2382 & ' will skip next contacts for this conf.'
2384 jcont_hb(num_conti,i)=j
2385 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2386 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2387 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2389 d_cont(num_conti,i)=rij
2390 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2391 C --- Electrostatic-interaction matrix ---
2392 a_chuj(1,1,num_conti,i)=a22
2393 a_chuj(1,2,num_conti,i)=a23
2394 a_chuj(2,1,num_conti,i)=a32
2395 a_chuj(2,2,num_conti,i)=a33
2396 C --- Gradient of rij
2398 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2401 c a_chuj(1,1,num_conti,i)=-0.61d0
2402 c a_chuj(1,2,num_conti,i)= 0.4d0
2403 c a_chuj(2,1,num_conti,i)= 0.65d0
2404 c a_chuj(2,2,num_conti,i)= 0.50d0
2405 c else if (i.eq.2) then
2406 c a_chuj(1,1,num_conti,i)= 0.0d0
2407 c a_chuj(1,2,num_conti,i)= 0.0d0
2408 c a_chuj(2,1,num_conti,i)= 0.0d0
2409 c a_chuj(2,2,num_conti,i)= 0.0d0
2411 C --- and its gradients
2412 cd write (iout,*) 'i',i,' j',j
2414 cd write (iout,*) 'iii 1 kkk',kkk
2415 cd write (iout,*) agg(kkk,:)
2418 cd write (iout,*) 'iii 2 kkk',kkk
2419 cd write (iout,*) aggi(kkk,:)
2422 cd write (iout,*) 'iii 3 kkk',kkk
2423 cd write (iout,*) aggi1(kkk,:)
2426 cd write (iout,*) 'iii 4 kkk',kkk
2427 cd write (iout,*) aggj(kkk,:)
2430 cd write (iout,*) 'iii 5 kkk',kkk
2431 cd write (iout,*) aggj1(kkk,:)
2438 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2439 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2440 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2441 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2442 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2444 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2450 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2451 C Calculate contact energies
2453 wij=cosa-3.0D0*cosb*cosg
2456 c fac3=dsqrt(-ael6i)/r0ij**3
2457 fac3=dsqrt(-ael6i)*r3ij
2458 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2459 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2461 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2462 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2463 C Diagnostics. Comment out or remove after debugging!
2464 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2465 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2466 c ees0m(num_conti,i)=0.0D0
2468 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2469 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2470 facont_hb(num_conti,i)=fcont
2472 C Angular derivatives of the contact function
2473 ees0pij1=fac3/ees0pij
2474 ees0mij1=fac3/ees0mij
2475 fac3p=-3.0D0*fac3*rrmij
2476 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2477 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2479 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2480 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2481 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2482 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2483 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2484 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2485 ecosap=ecosa1+ecosa2
2486 ecosbp=ecosb1+ecosb2
2487 ecosgp=ecosg1+ecosg2
2488 ecosam=ecosa1-ecosa2
2489 ecosbm=ecosb1-ecosb2
2490 ecosgm=ecosg1-ecosg2
2499 fprimcont=fprimcont/rij
2500 cd facont_hb(num_conti,i)=1.0D0
2501 C Following line is for diagnostics.
2504 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2505 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2508 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2509 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2511 gggp(1)=gggp(1)+ees0pijp*xj
2512 gggp(2)=gggp(2)+ees0pijp*yj
2513 gggp(3)=gggp(3)+ees0pijp*zj
2514 gggm(1)=gggm(1)+ees0mijp*xj
2515 gggm(2)=gggm(2)+ees0mijp*yj
2516 gggm(3)=gggm(3)+ees0mijp*zj
2517 C Derivatives due to the contact function
2518 gacont_hbr(1,num_conti,i)=fprimcont*xj
2519 gacont_hbr(2,num_conti,i)=fprimcont*yj
2520 gacont_hbr(3,num_conti,i)=fprimcont*zj
2522 ghalfp=0.5D0*gggp(k)
2523 ghalfm=0.5D0*gggm(k)
2524 gacontp_hb1(k,num_conti,i)=ghalfp
2525 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2526 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2527 gacontp_hb2(k,num_conti,i)=ghalfp
2528 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2529 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2530 gacontp_hb3(k,num_conti,i)=gggp(k)
2531 gacontm_hb1(k,num_conti,i)=ghalfm
2532 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2533 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2534 gacontm_hb2(k,num_conti,i)=ghalfm
2535 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2536 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2537 gacontm_hb3(k,num_conti,i)=gggm(k)
2540 C Diagnostics. Comment out or remove after debugging!
2542 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2543 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2544 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2545 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2546 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2547 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2550 endif ! num_conti.le.maxconts
2555 num_cont_hb(i)=num_conti
2559 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2560 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2562 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2563 ccc eel_loc=eel_loc+eello_turn3
2566 C-----------------------------------------------------------------------------
2567 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2568 C Third- and fourth-order contributions from turns
2569 implicit real*8 (a-h,o-z)
2570 include 'DIMENSIONS'
2571 include 'DIMENSIONS.ZSCOPT'
2572 include 'COMMON.IOUNITS'
2573 include 'COMMON.GEO'
2574 include 'COMMON.VAR'
2575 include 'COMMON.LOCAL'
2576 include 'COMMON.CHAIN'
2577 include 'COMMON.DERIV'
2578 include 'COMMON.INTERACT'
2579 include 'COMMON.CONTACTS'
2580 include 'COMMON.TORSION'
2581 include 'COMMON.VECTORS'
2582 include 'COMMON.FFIELD'
2584 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2585 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2586 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2587 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2588 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2589 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2591 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2593 C Third-order contributions
2600 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2601 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2602 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2603 call transpose2(auxmat(1,1),auxmat1(1,1))
2604 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2605 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2606 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2607 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2608 cd & ' eello_turn3_num',4*eello_turn3_num
2610 C Derivatives in gamma(i)
2611 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2612 call transpose2(auxmat2(1,1),pizda(1,1))
2613 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2614 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2615 C Derivatives in gamma(i+1)
2616 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2617 call transpose2(auxmat2(1,1),pizda(1,1))
2618 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2619 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2620 & +0.5d0*(pizda(1,1)+pizda(2,2))
2621 C Cartesian derivatives
2623 a_temp(1,1)=aggi(l,1)
2624 a_temp(1,2)=aggi(l,2)
2625 a_temp(2,1)=aggi(l,3)
2626 a_temp(2,2)=aggi(l,4)
2627 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2628 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2629 & +0.5d0*(pizda(1,1)+pizda(2,2))
2630 a_temp(1,1)=aggi1(l,1)
2631 a_temp(1,2)=aggi1(l,2)
2632 a_temp(2,1)=aggi1(l,3)
2633 a_temp(2,2)=aggi1(l,4)
2634 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2635 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2636 & +0.5d0*(pizda(1,1)+pizda(2,2))
2637 a_temp(1,1)=aggj(l,1)
2638 a_temp(1,2)=aggj(l,2)
2639 a_temp(2,1)=aggj(l,3)
2640 a_temp(2,2)=aggj(l,4)
2641 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2642 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2643 & +0.5d0*(pizda(1,1)+pizda(2,2))
2644 a_temp(1,1)=aggj1(l,1)
2645 a_temp(1,2)=aggj1(l,2)
2646 a_temp(2,1)=aggj1(l,3)
2647 a_temp(2,2)=aggj1(l,4)
2648 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2649 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2650 & +0.5d0*(pizda(1,1)+pizda(2,2))
2653 else if (j.eq.i+3) then
2654 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2656 C Fourth-order contributions
2664 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2665 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2666 iti1=itortyp(itype(i+1))
2667 iti2=itortyp(itype(i+2))
2668 iti3=itortyp(itype(i+3))
2669 call transpose2(EUg(1,1,i+1),e1t(1,1))
2670 call transpose2(Eug(1,1,i+2),e2t(1,1))
2671 call transpose2(Eug(1,1,i+3),e3t(1,1))
2672 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2673 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2674 s1=scalar2(b1(1,iti2),auxvec(1))
2675 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2676 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2677 s2=scalar2(b1(1,iti1),auxvec(1))
2678 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2679 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2680 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2681 eello_turn4=eello_turn4-(s1+s2+s3)
2682 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2683 cd & ' eello_turn4_num',8*eello_turn4_num
2684 C Derivatives in gamma(i)
2686 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2687 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2688 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2689 s1=scalar2(b1(1,iti2),auxvec(1))
2690 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2691 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2692 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2693 C Derivatives in gamma(i+1)
2694 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2695 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2696 s2=scalar2(b1(1,iti1),auxvec(1))
2697 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2698 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2699 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2700 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2701 C Derivatives in gamma(i+2)
2702 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2703 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2704 s1=scalar2(b1(1,iti2),auxvec(1))
2705 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2706 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2707 s2=scalar2(b1(1,iti1),auxvec(1))
2708 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2709 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2710 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2711 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2712 C Cartesian derivatives
2713 C Derivatives of this turn contributions in DC(i+2)
2714 if (j.lt.nres-1) then
2716 a_temp(1,1)=agg(l,1)
2717 a_temp(1,2)=agg(l,2)
2718 a_temp(2,1)=agg(l,3)
2719 a_temp(2,2)=agg(l,4)
2720 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2721 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2722 s1=scalar2(b1(1,iti2),auxvec(1))
2723 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2724 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2725 s2=scalar2(b1(1,iti1),auxvec(1))
2726 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2727 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2728 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2730 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2733 C Remaining derivatives of this turn contribution
2735 a_temp(1,1)=aggi(l,1)
2736 a_temp(1,2)=aggi(l,2)
2737 a_temp(2,1)=aggi(l,3)
2738 a_temp(2,2)=aggi(l,4)
2739 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2740 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2741 s1=scalar2(b1(1,iti2),auxvec(1))
2742 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2743 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2744 s2=scalar2(b1(1,iti1),auxvec(1))
2745 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2746 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2747 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2748 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2749 a_temp(1,1)=aggi1(l,1)
2750 a_temp(1,2)=aggi1(l,2)
2751 a_temp(2,1)=aggi1(l,3)
2752 a_temp(2,2)=aggi1(l,4)
2753 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2754 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2755 s1=scalar2(b1(1,iti2),auxvec(1))
2756 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2757 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2758 s2=scalar2(b1(1,iti1),auxvec(1))
2759 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2760 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2761 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2762 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2763 a_temp(1,1)=aggj(l,1)
2764 a_temp(1,2)=aggj(l,2)
2765 a_temp(2,1)=aggj(l,3)
2766 a_temp(2,2)=aggj(l,4)
2767 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2768 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2769 s1=scalar2(b1(1,iti2),auxvec(1))
2770 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2771 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2772 s2=scalar2(b1(1,iti1),auxvec(1))
2773 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2774 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2775 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2776 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2777 a_temp(1,1)=aggj1(l,1)
2778 a_temp(1,2)=aggj1(l,2)
2779 a_temp(2,1)=aggj1(l,3)
2780 a_temp(2,2)=aggj1(l,4)
2781 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2782 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2783 s1=scalar2(b1(1,iti2),auxvec(1))
2784 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2785 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2786 s2=scalar2(b1(1,iti1),auxvec(1))
2787 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2788 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2789 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2790 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2796 C-----------------------------------------------------------------------------
2797 subroutine vecpr(u,v,w)
2798 implicit real*8(a-h,o-z)
2799 dimension u(3),v(3),w(3)
2800 w(1)=u(2)*v(3)-u(3)*v(2)
2801 w(2)=-u(1)*v(3)+u(3)*v(1)
2802 w(3)=u(1)*v(2)-u(2)*v(1)
2805 C-----------------------------------------------------------------------------
2806 subroutine unormderiv(u,ugrad,unorm,ungrad)
2807 C This subroutine computes the derivatives of a normalized vector u, given
2808 C the derivatives computed without normalization conditions, ugrad. Returns
2811 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2812 double precision vec(3)
2813 double precision scalar
2815 c write (2,*) 'ugrad',ugrad
2818 vec(i)=scalar(ugrad(1,i),u(1))
2820 c write (2,*) 'vec',vec
2823 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2826 c write (2,*) 'ungrad',ungrad
2829 C-----------------------------------------------------------------------------
2830 subroutine escp(evdw2,evdw2_14)
2832 C This subroutine calculates the excluded-volume interaction energy between
2833 C peptide-group centers and side chains and its gradient in virtual-bond and
2834 C side-chain vectors.
2836 implicit real*8 (a-h,o-z)
2837 include 'DIMENSIONS'
2838 include 'DIMENSIONS.ZSCOPT'
2839 include 'COMMON.GEO'
2840 include 'COMMON.VAR'
2841 include 'COMMON.LOCAL'
2842 include 'COMMON.CHAIN'
2843 include 'COMMON.DERIV'
2844 include 'COMMON.INTERACT'
2845 include 'COMMON.FFIELD'
2846 include 'COMMON.IOUNITS'
2850 cd print '(a)','Enter ESCP'
2851 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2852 c & ' scal14',scal14
2853 do i=iatscp_s,iatscp_e
2855 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2856 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2857 if (iteli.eq.0) goto 1225
2858 xi=0.5D0*(c(1,i)+c(1,i+1))
2859 yi=0.5D0*(c(2,i)+c(2,i+1))
2860 zi=0.5D0*(c(3,i)+c(3,i+1))
2862 do iint=1,nscp_gr(i)
2864 do j=iscpstart(i,iint),iscpend(i,iint)
2866 C Uncomment following three lines for SC-p interactions
2870 C Uncomment following three lines for Ca-p interactions
2874 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2876 e1=fac*fac*aad(itypj,iteli)
2877 e2=fac*bad(itypj,iteli)
2878 if (iabs(j-i) .le. 2) then
2881 evdw2_14=evdw2_14+e1+e2
2884 c write (iout,*) i,j,evdwij
2888 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2890 fac=-(evdwij+e1)*rrij
2895 cd write (iout,*) 'j<i'
2896 C Uncomment following three lines for SC-p interactions
2898 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2901 cd write (iout,*) 'j>i'
2904 C Uncomment following line for SC-p interactions
2905 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2909 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2913 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2914 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2917 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2927 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2928 gradx_scp(j,i)=expon*gradx_scp(j,i)
2931 C******************************************************************************
2935 C To save time the factor EXPON has been extracted from ALL components
2936 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2939 C******************************************************************************
2942 C--------------------------------------------------------------------------
2943 subroutine edis(ehpb)
2945 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2947 implicit real*8 (a-h,o-z)
2948 include 'DIMENSIONS'
2949 include 'COMMON.SBRIDGE'
2950 include 'COMMON.CHAIN'
2951 include 'COMMON.DERIV'
2952 include 'COMMON.VAR'
2953 include 'COMMON.INTERACT'
2954 include 'COMMON.IOUNITS'
2957 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2958 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2959 if (link_end.eq.0) return
2960 do i=link_start,link_end
2961 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2962 C CA-CA distance used in regularization of structure.
2965 C iii and jjj point to the residues for which the distance is assigned.
2966 if (ii.gt.nres) then
2973 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2974 c & dhpb(i),dhpb1(i),forcon(i)
2975 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2976 C distance and angle dependent SS bond potential.
2977 if (.not.dyn_ss .and. i.le.nss) then
2978 C 15/02/13 CC dynamic SSbond - additional check
2979 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2980 call ssbond_ene(iii,jjj,eij)
2983 cd write (iout,*) "eij",eij
2984 else if (ii.gt.nres .and. jj.gt.nres) then
2985 c Restraints from contact prediction
2987 if (dhpb1(i).gt.0.0d0) then
2988 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2989 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2990 c write (iout,*) "beta nmr",
2991 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2995 C Get the force constant corresponding to this distance.
2997 C Calculate the contribution to energy.
2998 ehpb=ehpb+waga*rdis*rdis
2999 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3001 C Evaluate gradient.
3006 ggg(j)=fac*(c(j,jj)-c(j,ii))
3009 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3010 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3013 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3014 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3017 C Calculate the distance between the two points and its difference from the
3020 if (dhpb1(i).gt.0.0d0) then
3021 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3022 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3023 c write (iout,*) "alph nmr",
3024 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3027 C Get the force constant corresponding to this distance.
3029 C Calculate the contribution to energy.
3030 ehpb=ehpb+waga*rdis*rdis
3031 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3033 C Evaluate gradient.
3037 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3038 cd & ' waga=',waga,' fac=',fac
3040 ggg(j)=fac*(c(j,jj)-c(j,ii))
3042 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3043 C If this is a SC-SC distance, we need to calculate the contributions to the
3044 C Cartesian gradient in the SC vectors (ghpbx).
3047 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3048 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3052 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3053 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3060 C--------------------------------------------------------------------------
3061 subroutine ssbond_ene(i,j,eij)
3063 C Calculate the distance and angle dependent SS-bond potential energy
3064 C using a free-energy function derived based on RHF/6-31G** ab initio
3065 C calculations of diethyl disulfide.
3067 C A. Liwo and U. Kozlowska, 11/24/03
3069 implicit real*8 (a-h,o-z)
3070 include 'DIMENSIONS'
3071 include 'DIMENSIONS.ZSCOPT'
3072 include 'COMMON.SBRIDGE'
3073 include 'COMMON.CHAIN'
3074 include 'COMMON.DERIV'
3075 include 'COMMON.LOCAL'
3076 include 'COMMON.INTERACT'
3077 include 'COMMON.VAR'
3078 include 'COMMON.IOUNITS'
3079 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3084 dxi=dc_norm(1,nres+i)
3085 dyi=dc_norm(2,nres+i)
3086 dzi=dc_norm(3,nres+i)
3087 dsci_inv=dsc_inv(itypi)
3089 dscj_inv=dsc_inv(itypj)
3093 dxj=dc_norm(1,nres+j)
3094 dyj=dc_norm(2,nres+j)
3095 dzj=dc_norm(3,nres+j)
3096 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3101 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3102 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3103 om12=dxi*dxj+dyi*dyj+dzi*dzj
3105 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3106 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3112 deltat12=om2-om1+2.0d0
3114 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3115 & +akct*deltad*deltat12+ebr
3116 c & +akct*deltad*deltat12
3117 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3118 write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3119 & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3120 & " deltat12",deltat12," eij",eij,"ebr",ebr
3121 ed=2*akcm*deltad+akct*deltat12
3123 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3124 eom1=-2*akth*deltat1-pom1-om2*pom2
3125 eom2= 2*akth*deltat2+pom1-om1*pom2
3128 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3131 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3132 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3133 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3134 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3137 C Calculate the components of the gradient in DC and X
3141 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3146 C--------------------------------------------------------------------------
3147 c MODELLER restraint function
3148 subroutine e_modeller(ehomology_constr)
3149 implicit real*8 (a-h,o-z)
3150 include 'DIMENSIONS'
3152 integer nnn, i, j, k, ki, irec, l
3153 integer katy, odleglosci, test7
3154 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3155 real*8 distance(max_template),distancek(max_template),
3156 & min_odl,godl(max_template),dih_diff(max_template)
3158 include 'COMMON.SBRIDGE'
3159 include 'COMMON.CHAIN'
3160 include 'COMMON.GEO'
3161 include 'COMMON.DERIV'
3162 include 'COMMON.LOCAL'
3163 include 'COMMON.INTERACT'
3164 include 'COMMON.VAR'
3165 include 'COMMON.IOUNITS'
3166 include 'COMMON.CONTROL'
3170 distancek(i)=9999999.9
3175 c write (iout,*) "waga_dist",waga_dist
3177 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3179 C AL 5/2/14 - Introduce list of restraints
3180 do ii = link_start_homo,link_end_homo
3184 do k=1,constr_homology
3185 distance(k)=odl(k,ii)-dij
3186 distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3189 min_odl=minval(distancek)
3191 write (iout,*) "ij dij",i,j,dij
3192 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3193 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3194 write (iout,* )"min_odl",min_odl
3197 do k=1,constr_homology
3198 c Nie wiem po co to liczycie jeszcze raz!
3199 c odleg3=-waga_dist*((distance(i,j,k)**2)/
3200 c & (2*(sigma_odl(i,j,k))**2))
3201 godl(k)=dexp(-distancek(k)+min_odl)
3202 odleg2=odleg2+godl(k)
3204 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3205 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3206 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3207 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3211 write (iout,*) "godl",(godl(k),k=1,constr_homology)
3212 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2
3214 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3218 do k=1,constr_homology
3219 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3220 c & *waga_dist)+min_odl
3221 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3222 sum_sgodl=sum_sgodl+sgodl
3224 c sgodl2=sgodl2+sgodl
3225 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3226 c write(iout,*) "constr_homology=",constr_homology
3227 c write(iout,*) i, j, k, "TEST K"
3230 grad_odl3=sum_sgodl/(sum_godl*dij)
3233 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3234 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3235 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3237 ccc write(iout,*) godl, sgodl, grad_odl3
3239 c grad_odl=grad_odl+grad_odl3
3242 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3243 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3244 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3245 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3246 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3247 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3248 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3249 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3252 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3253 ccc & dLOG(odleg2),"-odleg=", -odleg
3256 c Pseudo-energy and gradient from dihedral-angle restraints from
3257 c homology templates
3258 c write (iout,*) "End of distance loop"
3261 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3262 do i=idihconstr_start_homo,idihconstr_end_homo
3264 c betai=beta(i,i+1,i+2,i+3)
3266 do k=1,constr_homology
3267 dih_diff(k)=pinorm(dih(k,i)-betai)
3268 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3269 c & -(6.28318-dih_diff(i,k))
3270 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3271 c & 6.28318+dih_diff(i,k)
3273 kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3276 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3280 write (iout,*) "i",i," betai",betai," kat2",kat2
3281 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3283 if (kat2.le.1.0d-14) cycle
3284 kat=kat-dLOG(kat2/constr_homology)
3286 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3287 ccc & dLOG(kat2), "-kat=", -kat
3289 c ----------------------------------------------------------------------
3291 c ----------------------------------------------------------------------
3295 do k=1,constr_homology
3296 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3297 sum_sgdih=sum_sgdih+sgdih
3299 grad_dih3=sum_sgdih/sum_gdih
3301 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3302 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3303 ccc & gloc(nphi+i-3,icg)
3304 gloc(i,icg)=gloc(i,icg)+grad_dih3
3305 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3306 ccc & gloc(nphi+i-3,icg)
3311 c Total energy from homology restraints
3313 write (iout,*) "odleg",odleg," kat",kat
3315 ehomology_constr=odleg+kat
3318 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3319 747 format(a12,i4,i4,i4,f8.3,f8.3)
3320 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3321 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3322 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3323 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3325 c-----------------------------------------------------------------------
3326 subroutine ebond(estr)
3328 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3330 implicit real*8 (a-h,o-z)
3331 include 'DIMENSIONS'
3332 include 'DIMENSIONS.ZSCOPT'
3333 include 'COMMON.LOCAL'
3334 include 'COMMON.GEO'
3335 include 'COMMON.INTERACT'
3336 include 'COMMON.DERIV'
3337 include 'COMMON.VAR'
3338 include 'COMMON.CHAIN'
3339 include 'COMMON.IOUNITS'
3340 include 'COMMON.NAMES'
3341 include 'COMMON.FFIELD'
3342 include 'COMMON.CONTROL'
3343 double precision u(3),ud(3)
3344 logical :: lprn=.false.
3347 diff = vbld(i)-vbldp0
3348 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3351 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3356 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3363 diff=vbld(i+nres)-vbldsc0(1,iti)
3365 & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3366 & AKSC(1,iti),AKSC(1,iti)*diff*diff
3367 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3369 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3373 diff=vbld(i+nres)-vbldsc0(j,iti)
3374 ud(j)=aksc(j,iti)*diff
3375 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3389 uprod2=uprod2*u(k)*u(k)
3393 usumsqder=usumsqder+ud(j)*uprod2
3396 & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3397 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3398 estr=estr+uprod/usum
3400 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3408 C--------------------------------------------------------------------------
3409 subroutine ebend(etheta)
3411 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3412 C angles gamma and its derivatives in consecutive thetas and gammas.
3414 implicit real*8 (a-h,o-z)
3415 include 'DIMENSIONS'
3416 include 'DIMENSIONS.ZSCOPT'
3417 include 'COMMON.LOCAL'
3418 include 'COMMON.GEO'
3419 include 'COMMON.INTERACT'
3420 include 'COMMON.DERIV'
3421 include 'COMMON.VAR'
3422 include 'COMMON.CHAIN'
3423 include 'COMMON.IOUNITS'
3424 include 'COMMON.NAMES'
3425 include 'COMMON.FFIELD'
3426 common /calcthet/ term1,term2,termm,diffak,ratak,
3427 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3428 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3429 double precision y(2),z(2)
3431 time11=dexp(-2*time)
3434 c write (iout,*) "nres",nres
3435 c write (*,'(a,i2)') 'EBEND ICG=',icg
3436 c write (iout,*) ithet_start,ithet_end
3437 do i=ithet_start,ithet_end
3438 C Zero the energy function and its derivative at 0 or pi.
3439 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3441 c if (i.gt.ithet_start .and.
3442 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3443 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3451 c if (i.lt.nres .and. itel(i).ne.0) then
3463 call proc_proc(phii,icrc)
3464 if (icrc.eq.1) phii=150.0
3478 call proc_proc(phii1,icrc)
3479 if (icrc.eq.1) phii1=150.0
3491 C Calculate the "mean" value of theta from the part of the distribution
3492 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3493 C In following comments this theta will be referred to as t_c.
3494 thet_pred_mean=0.0d0
3498 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3500 c write (iout,*) "thet_pred_mean",thet_pred_mean
3501 dthett=thet_pred_mean*ssd
3502 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3503 c write (iout,*) "thet_pred_mean",thet_pred_mean
3504 C Derivatives of the "mean" values in gamma1 and gamma2.
3505 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3506 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3507 if (theta(i).gt.pi-delta) then
3508 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3510 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3511 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3512 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3514 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3516 else if (theta(i).lt.delta) then
3517 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3518 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3519 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3521 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3522 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3525 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3528 etheta=etheta+ethetai
3529 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3530 c & rad2deg*phii,rad2deg*phii1,ethetai
3531 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3532 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3533 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3536 C Ufff.... We've done all this!!!
3539 C---------------------------------------------------------------------------
3540 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3542 implicit real*8 (a-h,o-z)
3543 include 'DIMENSIONS'
3544 include 'COMMON.LOCAL'
3545 include 'COMMON.IOUNITS'
3546 common /calcthet/ term1,term2,termm,diffak,ratak,
3547 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3548 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3549 C Calculate the contributions to both Gaussian lobes.
3550 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3551 C The "polynomial part" of the "standard deviation" of this part of
3555 sig=sig*thet_pred_mean+polthet(j,it)
3557 C Derivative of the "interior part" of the "standard deviation of the"
3558 C gamma-dependent Gaussian lobe in t_c.
3559 sigtc=3*polthet(3,it)
3561 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3564 C Set the parameters of both Gaussian lobes of the distribution.
3565 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3566 fac=sig*sig+sigc0(it)
3569 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3570 sigsqtc=-4.0D0*sigcsq*sigtc
3571 c print *,i,sig,sigtc,sigsqtc
3572 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3573 sigtc=-sigtc/(fac*fac)
3574 C Following variable is sigma(t_c)**(-2)
3575 sigcsq=sigcsq*sigcsq
3577 sig0inv=1.0D0/sig0i**2
3578 delthec=thetai-thet_pred_mean
3579 delthe0=thetai-theta0i
3580 term1=-0.5D0*sigcsq*delthec*delthec
3581 term2=-0.5D0*sig0inv*delthe0*delthe0
3582 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3583 C NaNs in taking the logarithm. We extract the largest exponent which is added
3584 C to the energy (this being the log of the distribution) at the end of energy
3585 C term evaluation for this virtual-bond angle.
3586 if (term1.gt.term2) then
3588 term2=dexp(term2-termm)
3592 term1=dexp(term1-termm)
3595 C The ratio between the gamma-independent and gamma-dependent lobes of
3596 C the distribution is a Gaussian function of thet_pred_mean too.
3597 diffak=gthet(2,it)-thet_pred_mean
3598 ratak=diffak/gthet(3,it)**2
3599 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3600 C Let's differentiate it in thet_pred_mean NOW.
3602 C Now put together the distribution terms to make complete distribution.
3603 termexp=term1+ak*term2
3604 termpre=sigc+ak*sig0i
3605 C Contribution of the bending energy from this theta is just the -log of
3606 C the sum of the contributions from the two lobes and the pre-exponential
3607 C factor. Simple enough, isn't it?
3608 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3609 C NOW the derivatives!!!
3610 C 6/6/97 Take into account the deformation.
3611 E_theta=(delthec*sigcsq*term1
3612 & +ak*delthe0*sig0inv*term2)/termexp
3613 E_tc=((sigtc+aktc*sig0i)/termpre
3614 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3615 & aktc*term2)/termexp)
3618 c-----------------------------------------------------------------------------
3619 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3620 implicit real*8 (a-h,o-z)
3621 include 'DIMENSIONS'
3622 include 'COMMON.LOCAL'
3623 include 'COMMON.IOUNITS'
3624 common /calcthet/ term1,term2,termm,diffak,ratak,
3625 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3626 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3627 delthec=thetai-thet_pred_mean
3628 delthe0=thetai-theta0i
3629 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3630 t3 = thetai-thet_pred_mean
3634 t14 = t12+t6*sigsqtc
3636 t21 = thetai-theta0i
3642 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3643 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3644 & *(-t12*t9-ak*sig0inv*t27)
3648 C--------------------------------------------------------------------------
3649 subroutine ebend(etheta)
3651 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3652 C angles gamma and its derivatives in consecutive thetas and gammas.
3653 C ab initio-derived potentials from
3654 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3656 implicit real*8 (a-h,o-z)
3657 include 'DIMENSIONS'
3658 include 'DIMENSIONS.ZSCOPT'
3659 include 'COMMON.LOCAL'
3660 include 'COMMON.GEO'
3661 include 'COMMON.INTERACT'
3662 include 'COMMON.DERIV'
3663 include 'COMMON.VAR'
3664 include 'COMMON.CHAIN'
3665 include 'COMMON.IOUNITS'
3666 include 'COMMON.NAMES'
3667 include 'COMMON.FFIELD'
3668 include 'COMMON.CONTROL'
3669 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3670 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3671 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3672 & sinph1ph2(maxdouble,maxdouble)
3673 logical lprn /.false./, lprn1 /.false./
3675 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3676 do i=ithet_start,ithet_end
3680 theti2=0.5d0*theta(i)
3681 ityp2=ithetyp(itype(i-1))
3683 coskt(k)=dcos(k*theti2)
3684 sinkt(k)=dsin(k*theti2)
3689 if (phii.ne.phii) phii=150.0
3693 ityp1=ithetyp(itype(i-2))
3695 cosph1(k)=dcos(k*phii)
3696 sinph1(k)=dsin(k*phii)
3709 if (phii1.ne.phii1) phii1=150.0
3714 ityp3=ithetyp(itype(i))
3716 cosph2(k)=dcos(k*phii1)
3717 sinph2(k)=dsin(k*phii1)
3727 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3728 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3730 ethetai=aa0thet(ityp1,ityp2,ityp3)
3733 ccl=cosph1(l)*cosph2(k-l)
3734 ssl=sinph1(l)*sinph2(k-l)
3735 scl=sinph1(l)*cosph2(k-l)
3736 csl=cosph1(l)*sinph2(k-l)
3737 cosph1ph2(l,k)=ccl-ssl
3738 cosph1ph2(k,l)=ccl+ssl
3739 sinph1ph2(l,k)=scl+csl
3740 sinph1ph2(k,l)=scl-csl
3744 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3745 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3746 write (iout,*) "coskt and sinkt"
3748 write (iout,*) k,coskt(k),sinkt(k)
3752 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3753 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3756 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3757 & " ethetai",ethetai
3760 write (iout,*) "cosph and sinph"
3762 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3764 write (iout,*) "cosph1ph2 and sinph2ph2"
3767 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3768 & sinph1ph2(l,k),sinph1ph2(k,l)
3771 write(iout,*) "ethetai",ethetai
3775 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3776 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3777 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3778 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3779 ethetai=ethetai+sinkt(m)*aux
3780 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3781 dephii=dephii+k*sinkt(m)*(
3782 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3783 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3784 dephii1=dephii1+k*sinkt(m)*(
3785 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3786 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3788 & write (iout,*) "m",m," k",k," bbthet",
3789 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3790 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3791 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3792 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3796 & write(iout,*) "ethetai",ethetai
3800 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3801 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3802 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3803 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3804 ethetai=ethetai+sinkt(m)*aux
3805 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3806 dephii=dephii+l*sinkt(m)*(
3807 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3808 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3809 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3810 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3811 dephii1=dephii1+(k-l)*sinkt(m)*(
3812 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3813 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3814 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3815 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3817 write (iout,*) "m",m," k",k," l",l," ffthet",
3818 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3819 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3820 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3821 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3822 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3823 & cosph1ph2(k,l)*sinkt(m),
3824 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3831 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
3832 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
3833 & phii1*rad2deg,ethetai
3835 etheta=etheta+ethetai
3837 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3838 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3839 gloc(nphi+i-2,icg)=wang*dethetai
3845 c-----------------------------------------------------------------------------
3846 subroutine esc(escloc)
3847 C Calculate the local energy of a side chain and its derivatives in the
3848 C corresponding virtual-bond valence angles THETA and the spherical angles
3850 implicit real*8 (a-h,o-z)
3851 include 'DIMENSIONS'
3852 include 'DIMENSIONS.ZSCOPT'
3853 include 'COMMON.GEO'
3854 include 'COMMON.LOCAL'
3855 include 'COMMON.VAR'
3856 include 'COMMON.INTERACT'
3857 include 'COMMON.DERIV'
3858 include 'COMMON.CHAIN'
3859 include 'COMMON.IOUNITS'
3860 include 'COMMON.NAMES'
3861 include 'COMMON.FFIELD'
3862 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3863 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3864 common /sccalc/ time11,time12,time112,theti,it,nlobit
3867 c write (iout,'(a)') 'ESC'
3868 do i=loc_start,loc_end
3870 if (it.eq.10) goto 1
3872 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3873 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3874 theti=theta(i+1)-pipol
3878 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3880 if (x(2).gt.pi-delta) then
3884 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3886 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3887 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3889 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3890 & ddersc0(1),dersc(1))
3891 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3892 & ddersc0(3),dersc(3))
3894 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3896 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3897 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3898 & dersc0(2),esclocbi,dersc02)
3899 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3901 call splinthet(x(2),0.5d0*delta,ss,ssd)
3906 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3908 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3909 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3911 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3913 c write (iout,*) escloci
3914 else if (x(2).lt.delta) then
3918 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3920 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3921 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3923 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3924 & ddersc0(1),dersc(1))
3925 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3926 & ddersc0(3),dersc(3))
3928 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3930 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3931 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3932 & dersc0(2),esclocbi,dersc02)
3933 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3938 call splinthet(x(2),0.5d0*delta,ss,ssd)
3940 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3942 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3943 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3945 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3946 c write (iout,*) escloci
3948 call enesc(x,escloci,dersc,ddummy,.false.)
3951 escloc=escloc+escloci
3952 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3954 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3956 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3957 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3962 C---------------------------------------------------------------------------
3963 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3964 implicit real*8 (a-h,o-z)
3965 include 'DIMENSIONS'
3966 include 'COMMON.GEO'
3967 include 'COMMON.LOCAL'
3968 include 'COMMON.IOUNITS'
3969 common /sccalc/ time11,time12,time112,theti,it,nlobit
3970 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3971 double precision contr(maxlob,-1:1)
3973 c write (iout,*) 'it=',it,' nlobit=',nlobit
3977 if (mixed) ddersc(j)=0.0d0
3981 C Because of periodicity of the dependence of the SC energy in omega we have
3982 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3983 C To avoid underflows, first compute & store the exponents.
3991 z(k)=x(k)-censc(k,j,it)
3996 Axk=Axk+gaussc(l,k,j,it)*z(l)
4002 expfac=expfac+Ax(k,j,iii)*z(k)
4010 C As in the case of ebend, we want to avoid underflows in exponentiation and
4011 C subsequent NaNs and INFs in energy calculation.
4012 C Find the largest exponent
4016 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4020 cd print *,'it=',it,' emin=',emin
4022 C Compute the contribution to SC energy and derivatives
4026 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4027 cd print *,'j=',j,' expfac=',expfac
4028 escloc_i=escloc_i+expfac
4030 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4034 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4035 & +gaussc(k,2,j,it))*expfac
4042 dersc(1)=dersc(1)/cos(theti)**2
4043 ddersc(1)=ddersc(1)/cos(theti)**2
4046 escloci=-(dlog(escloc_i)-emin)
4048 dersc(j)=dersc(j)/escloc_i
4052 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4057 C------------------------------------------------------------------------------
4058 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4059 implicit real*8 (a-h,o-z)
4060 include 'DIMENSIONS'
4061 include 'COMMON.GEO'
4062 include 'COMMON.LOCAL'
4063 include 'COMMON.IOUNITS'
4064 common /sccalc/ time11,time12,time112,theti,it,nlobit
4065 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4066 double precision contr(maxlob)
4077 z(k)=x(k)-censc(k,j,it)
4083 Axk=Axk+gaussc(l,k,j,it)*z(l)
4089 expfac=expfac+Ax(k,j)*z(k)
4094 C As in the case of ebend, we want to avoid underflows in exponentiation and
4095 C subsequent NaNs and INFs in energy calculation.
4096 C Find the largest exponent
4099 if (emin.gt.contr(j)) emin=contr(j)
4103 C Compute the contribution to SC energy and derivatives
4107 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4108 escloc_i=escloc_i+expfac
4110 dersc(k)=dersc(k)+Ax(k,j)*expfac
4112 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4113 & +gaussc(1,2,j,it))*expfac
4117 dersc(1)=dersc(1)/cos(theti)**2
4118 dersc12=dersc12/cos(theti)**2
4119 escloci=-(dlog(escloc_i)-emin)
4121 dersc(j)=dersc(j)/escloc_i
4123 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4127 c----------------------------------------------------------------------------------
4128 subroutine esc(escloc)
4129 C Calculate the local energy of a side chain and its derivatives in the
4130 C corresponding virtual-bond valence angles THETA and the spherical angles
4131 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4132 C added by Urszula Kozlowska. 07/11/2007
4134 implicit real*8 (a-h,o-z)
4135 include 'DIMENSIONS'
4136 include 'DIMENSIONS.ZSCOPT'
4137 include 'COMMON.GEO'
4138 include 'COMMON.LOCAL'
4139 include 'COMMON.VAR'
4140 include 'COMMON.SCROT'
4141 include 'COMMON.INTERACT'
4142 include 'COMMON.DERIV'
4143 include 'COMMON.CHAIN'
4144 include 'COMMON.IOUNITS'
4145 include 'COMMON.NAMES'
4146 include 'COMMON.FFIELD'
4147 include 'COMMON.CONTROL'
4148 include 'COMMON.VECTORS'
4149 double precision x_prime(3),y_prime(3),z_prime(3)
4150 & , sumene,dsc_i,dp2_i,x(65),
4151 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4152 & de_dxx,de_dyy,de_dzz,de_dt
4153 double precision s1_t,s1_6_t,s2_t,s2_6_t
4155 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4156 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4157 & dt_dCi(3),dt_dCi1(3)
4158 common /sccalc/ time11,time12,time112,theti,it,nlobit
4161 do i=loc_start,loc_end
4162 costtab(i+1) =dcos(theta(i+1))
4163 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4164 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4165 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4166 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4167 cosfac=dsqrt(cosfac2)
4168 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4169 sinfac=dsqrt(sinfac2)
4171 if (it.eq.10) goto 1
4173 C Compute the axes of tghe local cartesian coordinates system; store in
4174 c x_prime, y_prime and z_prime
4181 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4182 C & dc_norm(3,i+nres)
4184 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4185 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4188 z_prime(j) = -uz(j,i-1)
4191 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4192 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4193 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4194 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4195 c & " xy",scalar(x_prime(1),y_prime(1)),
4196 c & " xz",scalar(x_prime(1),z_prime(1)),
4197 c & " yy",scalar(y_prime(1),y_prime(1)),
4198 c & " yz",scalar(y_prime(1),z_prime(1)),
4199 c & " zz",scalar(z_prime(1),z_prime(1))
4201 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4202 C to local coordinate system. Store in xx, yy, zz.
4208 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4209 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4210 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4217 C Compute the energy of the ith side cbain
4219 c write (2,*) "xx",xx," yy",yy," zz",zz
4222 x(j) = sc_parmin(j,it)
4225 Cc diagnostics - remove later
4227 yy1 = dsin(alph(2))*dcos(omeg(2))
4228 zz1 = -dsin(alph(2))*dsin(omeg(2))
4229 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4230 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4232 C," --- ", xx_w,yy_w,zz_w
4235 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4236 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4238 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4239 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4241 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4242 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4243 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4244 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4245 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4247 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4248 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4249 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4250 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4251 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4253 dsc_i = 0.743d0+x(61)
4255 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4256 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4257 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4258 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4259 s1=(1+x(63))/(0.1d0 + dscp1)
4260 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4261 s2=(1+x(65))/(0.1d0 + dscp2)
4262 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4263 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4264 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4265 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4267 c & dscp1,dscp2,sumene
4268 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4269 escloc = escloc + sumene
4270 c write (2,*) "escloc",escloc
4271 if (.not. calc_grad) goto 1
4275 C This section to check the numerical derivatives of the energy of ith side
4276 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4277 C #define DEBUG in the code to turn it on.
4279 write (2,*) "sumene =",sumene
4283 write (2,*) xx,yy,zz
4284 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4285 de_dxx_num=(sumenep-sumene)/aincr
4287 write (2,*) "xx+ sumene from enesc=",sumenep
4290 write (2,*) xx,yy,zz
4291 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4292 de_dyy_num=(sumenep-sumene)/aincr
4294 write (2,*) "yy+ sumene from enesc=",sumenep
4297 write (2,*) xx,yy,zz
4298 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4299 de_dzz_num=(sumenep-sumene)/aincr
4301 write (2,*) "zz+ sumene from enesc=",sumenep
4302 costsave=cost2tab(i+1)
4303 sintsave=sint2tab(i+1)
4304 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4305 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4306 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4307 de_dt_num=(sumenep-sumene)/aincr
4308 write (2,*) " t+ sumene from enesc=",sumenep
4309 cost2tab(i+1)=costsave
4310 sint2tab(i+1)=sintsave
4311 C End of diagnostics section.
4314 C Compute the gradient of esc
4316 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4317 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4318 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4319 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4320 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4321 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4322 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4323 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4324 pom1=(sumene3*sint2tab(i+1)+sumene1)
4325 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4326 pom2=(sumene4*cost2tab(i+1)+sumene2)
4327 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4328 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4329 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4330 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4332 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4333 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4334 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4336 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4337 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4338 & +(pom1+pom2)*pom_dx
4340 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4343 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4344 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4345 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4347 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4348 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4349 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4350 & +x(59)*zz**2 +x(60)*xx*zz
4351 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4352 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4353 & +(pom1-pom2)*pom_dy
4355 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4358 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4359 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4360 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4361 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4362 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4363 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4364 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4365 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4367 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4370 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4371 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4372 & +pom1*pom_dt1+pom2*pom_dt2
4374 write(2,*), "de_dt = ", de_dt,de_dt_num
4378 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4379 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4380 cosfac2xx=cosfac2*xx
4381 sinfac2yy=sinfac2*yy
4383 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4385 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4387 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4388 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4389 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4390 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4391 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4392 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4393 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4394 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4395 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4396 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4400 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4401 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4404 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4405 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4406 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4408 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4409 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4413 dXX_Ctab(k,i)=dXX_Ci(k)
4414 dXX_C1tab(k,i)=dXX_Ci1(k)
4415 dYY_Ctab(k,i)=dYY_Ci(k)
4416 dYY_C1tab(k,i)=dYY_Ci1(k)
4417 dZZ_Ctab(k,i)=dZZ_Ci(k)
4418 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4419 dXX_XYZtab(k,i)=dXX_XYZ(k)
4420 dYY_XYZtab(k,i)=dYY_XYZ(k)
4421 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4425 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4426 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4427 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4428 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4429 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4431 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4432 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4433 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4434 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4435 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4436 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4437 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4438 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4440 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4441 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4443 C to check gradient call subroutine check_grad
4450 c------------------------------------------------------------------------------
4451 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4453 C This procedure calculates two-body contact function g(rij) and its derivative:
4456 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4459 C where x=(rij-r0ij)/delta
4461 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4464 double precision rij,r0ij,eps0ij,fcont,fprimcont
4465 double precision x,x2,x4,delta
4469 if (x.lt.-1.0D0) then
4472 else if (x.le.1.0D0) then
4475 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4476 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4483 c------------------------------------------------------------------------------
4484 subroutine splinthet(theti,delta,ss,ssder)
4485 implicit real*8 (a-h,o-z)
4486 include 'DIMENSIONS'
4487 include 'DIMENSIONS.ZSCOPT'
4488 include 'COMMON.VAR'
4489 include 'COMMON.GEO'
4492 if (theti.gt.pipol) then
4493 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4495 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4500 c------------------------------------------------------------------------------
4501 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4503 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4504 double precision ksi,ksi2,ksi3,a1,a2,a3
4505 a1=fprim0*delta/(f1-f0)
4511 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4512 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4515 c------------------------------------------------------------------------------
4516 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4518 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4519 double precision ksi,ksi2,ksi3,a1,a2,a3
4524 a2=3*(f1x-f0x)-2*fprim0x*delta
4525 a3=fprim0x*delta-2*(f1x-f0x)
4526 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4529 C-----------------------------------------------------------------------------
4531 C-----------------------------------------------------------------------------
4532 subroutine etor(etors,edihcnstr,fact)
4533 implicit real*8 (a-h,o-z)
4534 include 'DIMENSIONS'
4535 include 'DIMENSIONS.ZSCOPT'
4536 include 'COMMON.VAR'
4537 include 'COMMON.GEO'
4538 include 'COMMON.LOCAL'
4539 include 'COMMON.TORSION'
4540 include 'COMMON.INTERACT'
4541 include 'COMMON.DERIV'
4542 include 'COMMON.CHAIN'
4543 include 'COMMON.NAMES'
4544 include 'COMMON.IOUNITS'
4545 include 'COMMON.FFIELD'
4546 include 'COMMON.TORCNSTR'
4548 C Set lprn=.true. for debugging
4552 do i=iphi_start,iphi_end
4553 itori=itortyp(itype(i-2))
4554 itori1=itortyp(itype(i-1))
4557 C Proline-Proline pair is a special case...
4558 if (itori.eq.3 .and. itori1.eq.3) then
4559 if (phii.gt.-dwapi3) then
4561 fac=1.0D0/(1.0D0-cosphi)
4562 etorsi=v1(1,3,3)*fac
4563 etorsi=etorsi+etorsi
4564 etors=etors+etorsi-v1(1,3,3)
4565 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4568 v1ij=v1(j+1,itori,itori1)
4569 v2ij=v2(j+1,itori,itori1)
4572 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4573 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4577 v1ij=v1(j,itori,itori1)
4578 v2ij=v2(j,itori,itori1)
4581 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4582 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4586 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4587 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4588 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4589 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4590 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4592 ! 6/20/98 - dihedral angle constraints
4595 itori=idih_constr(i)
4598 if (difi.gt.drange(i)) then
4600 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4601 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4602 else if (difi.lt.-drange(i)) then
4604 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4605 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4607 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4608 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4610 ! write (iout,*) 'edihcnstr',edihcnstr
4613 c------------------------------------------------------------------------------
4615 subroutine etor(etors,edihcnstr,fact)
4616 implicit real*8 (a-h,o-z)
4617 include 'DIMENSIONS'
4618 include 'DIMENSIONS.ZSCOPT'
4619 include 'COMMON.VAR'
4620 include 'COMMON.GEO'
4621 include 'COMMON.LOCAL'
4622 include 'COMMON.TORSION'
4623 include 'COMMON.INTERACT'
4624 include 'COMMON.DERIV'
4625 include 'COMMON.CHAIN'
4626 include 'COMMON.NAMES'
4627 include 'COMMON.IOUNITS'
4628 include 'COMMON.FFIELD'
4629 include 'COMMON.TORCNSTR'
4631 C Set lprn=.true. for debugging
4635 do i=iphi_start,iphi_end
4636 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4637 itori=itortyp(itype(i-2))
4638 itori1=itortyp(itype(i-1))
4641 C Regular cosine and sine terms
4642 do j=1,nterm(itori,itori1)
4643 v1ij=v1(j,itori,itori1)
4644 v2ij=v2(j,itori,itori1)
4647 etors=etors+v1ij*cosphi+v2ij*sinphi
4648 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4652 C E = SUM ----------------------------------- - v1
4653 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4655 cosphi=dcos(0.5d0*phii)
4656 sinphi=dsin(0.5d0*phii)
4657 do j=1,nlor(itori,itori1)
4658 vl1ij=vlor1(j,itori,itori1)
4659 vl2ij=vlor2(j,itori,itori1)
4660 vl3ij=vlor3(j,itori,itori1)
4661 pom=vl2ij*cosphi+vl3ij*sinphi
4662 pom1=1.0d0/(pom*pom+1.0d0)
4663 etors=etors+vl1ij*pom1
4665 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4667 C Subtract the constant term
4668 etors=etors-v0(itori,itori1)
4670 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4671 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4672 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4673 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4674 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4677 ! 6/20/98 - dihedral angle constraints
4680 itori=idih_constr(i)
4682 difi=pinorm(phii-phi0(i))
4684 if (difi.gt.drange(i)) then
4686 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4687 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4688 edihi=0.25d0*ftors*difi**4
4689 else if (difi.lt.-drange(i)) then
4691 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4692 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4693 edihi=0.25d0*ftors*difi**4
4697 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4699 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4700 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4702 ! write (iout,*) 'edihcnstr',edihcnstr
4705 c----------------------------------------------------------------------------
4706 subroutine etor_d(etors_d,fact2)
4707 C 6/23/01 Compute double torsional energy
4708 implicit real*8 (a-h,o-z)
4709 include 'DIMENSIONS'
4710 include 'DIMENSIONS.ZSCOPT'
4711 include 'COMMON.VAR'
4712 include 'COMMON.GEO'
4713 include 'COMMON.LOCAL'
4714 include 'COMMON.TORSION'
4715 include 'COMMON.INTERACT'
4716 include 'COMMON.DERIV'
4717 include 'COMMON.CHAIN'
4718 include 'COMMON.NAMES'
4719 include 'COMMON.IOUNITS'
4720 include 'COMMON.FFIELD'
4721 include 'COMMON.TORCNSTR'
4723 C Set lprn=.true. for debugging
4727 do i=iphi_start,iphi_end-1
4728 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4730 itori=itortyp(itype(i-2))
4731 itori1=itortyp(itype(i-1))
4732 itori2=itortyp(itype(i))
4737 C Regular cosine and sine terms
4738 do j=1,ntermd_1(itori,itori1,itori2)
4739 v1cij=v1c(1,j,itori,itori1,itori2)
4740 v1sij=v1s(1,j,itori,itori1,itori2)
4741 v2cij=v1c(2,j,itori,itori1,itori2)
4742 v2sij=v1s(2,j,itori,itori1,itori2)
4743 cosphi1=dcos(j*phii)
4744 sinphi1=dsin(j*phii)
4745 cosphi2=dcos(j*phii1)
4746 sinphi2=dsin(j*phii1)
4747 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4748 & v2cij*cosphi2+v2sij*sinphi2
4749 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4750 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4752 do k=2,ntermd_2(itori,itori1,itori2)
4754 v1cdij = v2c(k,l,itori,itori1,itori2)
4755 v2cdij = v2c(l,k,itori,itori1,itori2)
4756 v1sdij = v2s(k,l,itori,itori1,itori2)
4757 v2sdij = v2s(l,k,itori,itori1,itori2)
4758 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4759 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4760 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4761 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4762 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4763 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4764 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4765 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4766 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4767 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4770 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4771 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4777 c------------------------------------------------------------------------------
4778 subroutine eback_sc_corr(esccor)
4779 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4780 c conformational states; temporarily implemented as differences
4781 c between UNRES torsional potentials (dependent on three types of
4782 c residues) and the torsional potentials dependent on all 20 types
4783 c of residues computed from AM1 energy surfaces of terminally-blocked
4784 c amino-acid residues.
4785 implicit real*8 (a-h,o-z)
4786 include 'DIMENSIONS'
4787 include 'DIMENSIONS.ZSCOPT'
4788 include 'COMMON.VAR'
4789 include 'COMMON.GEO'
4790 include 'COMMON.LOCAL'
4791 include 'COMMON.TORSION'
4792 include 'COMMON.SCCOR'
4793 include 'COMMON.INTERACT'
4794 include 'COMMON.DERIV'
4795 include 'COMMON.CHAIN'
4796 include 'COMMON.NAMES'
4797 include 'COMMON.IOUNITS'
4798 include 'COMMON.FFIELD'
4799 include 'COMMON.CONTROL'
4801 C Set lprn=.true. for debugging
4804 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
4806 do i=itau_start,itau_end
4808 isccori=isccortyp(itype(i-2))
4809 isccori1=isccortyp(itype(i-1))
4811 cccc Added 9 May 2012
4812 cc Tauangle is torsional engle depending on the value of first digit
4813 c(see comment below)
4814 cc Omicron is flat angle depending on the value of first digit
4815 c(see comment below)
4818 do intertyp=1,3 !intertyp
4819 cc Added 09 May 2012 (Adasko)
4820 cc Intertyp means interaction type of backbone mainchain correlation:
4821 c 1 = SC...Ca...Ca...Ca
4822 c 2 = Ca...Ca...Ca...SC
4823 c 3 = SC...Ca...Ca...SCi
4825 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4826 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4827 & (itype(i-1).eq.21)))
4828 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4829 & .or.(itype(i-2).eq.21)))
4830 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4831 & (itype(i-1).eq.21)))) cycle
4832 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4833 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4835 do j=1,nterm_sccor(isccori,isccori1)
4836 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4837 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4838 cosphi=dcos(j*tauangle(intertyp,i))
4839 sinphi=dsin(j*tauangle(intertyp,i))
4840 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4841 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4843 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4844 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4845 c &gloc_sc(intertyp,i-3,icg)
4847 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4848 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4849 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4850 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4851 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4855 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4859 c------------------------------------------------------------------------------
4860 subroutine multibody(ecorr)
4861 C This subroutine calculates multi-body contributions to energy following
4862 C the idea of Skolnick et al. If side chains I and J make a contact and
4863 C at the same time side chains I+1 and J+1 make a contact, an extra
4864 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4865 implicit real*8 (a-h,o-z)
4866 include 'DIMENSIONS'
4867 include 'COMMON.IOUNITS'
4868 include 'COMMON.DERIV'
4869 include 'COMMON.INTERACT'
4870 include 'COMMON.CONTACTS'
4871 double precision gx(3),gx1(3)
4874 C Set lprn=.true. for debugging
4878 write (iout,'(a)') 'Contact function values:'
4880 write (iout,'(i2,20(1x,i2,f10.5))')
4881 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4896 num_conti=num_cont(i)
4897 num_conti1=num_cont(i1)
4902 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4903 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4904 cd & ' ishift=',ishift
4905 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4906 C The system gains extra energy.
4907 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4908 endif ! j1==j+-ishift
4917 c------------------------------------------------------------------------------
4918 double precision function esccorr(i,j,k,l,jj,kk)
4919 implicit real*8 (a-h,o-z)
4920 include 'DIMENSIONS'
4921 include 'COMMON.IOUNITS'
4922 include 'COMMON.DERIV'
4923 include 'COMMON.INTERACT'
4924 include 'COMMON.CONTACTS'
4925 double precision gx(3),gx1(3)
4930 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4931 C Calculate the multi-body contribution to energy.
4932 C Calculate multi-body contributions to the gradient.
4933 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4934 cd & k,l,(gacont(m,kk,k),m=1,3)
4936 gx(m) =ekl*gacont(m,jj,i)
4937 gx1(m)=eij*gacont(m,kk,k)
4938 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4939 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4940 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4941 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4945 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4950 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4956 c------------------------------------------------------------------------------
4958 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4959 implicit real*8 (a-h,o-z)
4960 include 'DIMENSIONS'
4961 integer dimen1,dimen2,atom,indx
4962 double precision buffer(dimen1,dimen2)
4963 double precision zapas
4964 common /contacts_hb/ zapas(3,20,maxres,7),
4965 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4966 & num_cont_hb(maxres),jcont_hb(20,maxres)
4967 num_kont=num_cont_hb(atom)
4971 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4974 buffer(i,indx+22)=facont_hb(i,atom)
4975 buffer(i,indx+23)=ees0p(i,atom)
4976 buffer(i,indx+24)=ees0m(i,atom)
4977 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4979 buffer(1,indx+26)=dfloat(num_kont)
4982 c------------------------------------------------------------------------------
4983 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4984 implicit real*8 (a-h,o-z)
4985 include 'DIMENSIONS'
4986 integer dimen1,dimen2,atom,indx
4987 double precision buffer(dimen1,dimen2)
4988 double precision zapas
4989 common /contacts_hb/ zapas(3,20,maxres,7),
4990 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4991 & num_cont_hb(maxres),jcont_hb(20,maxres)
4992 num_kont=buffer(1,indx+26)
4993 num_kont_old=num_cont_hb(atom)
4994 num_cont_hb(atom)=num_kont+num_kont_old
4999 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5002 facont_hb(ii,atom)=buffer(i,indx+22)
5003 ees0p(ii,atom)=buffer(i,indx+23)
5004 ees0m(ii,atom)=buffer(i,indx+24)
5005 jcont_hb(ii,atom)=buffer(i,indx+25)
5009 c------------------------------------------------------------------------------
5011 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5012 C This subroutine calculates multi-body contributions to hydrogen-bonding
5013 implicit real*8 (a-h,o-z)
5014 include 'DIMENSIONS'
5015 include 'DIMENSIONS.ZSCOPT'
5016 include 'COMMON.IOUNITS'
5018 include 'COMMON.INFO'
5020 include 'COMMON.FFIELD'
5021 include 'COMMON.DERIV'
5022 include 'COMMON.INTERACT'
5023 include 'COMMON.CONTACTS'
5025 parameter (max_cont=maxconts)
5026 parameter (max_dim=2*(8*3+2))
5027 parameter (msglen1=max_cont*max_dim*4)
5028 parameter (msglen2=2*msglen1)
5029 integer source,CorrelType,CorrelID,Error
5030 double precision buffer(max_cont,max_dim)
5032 double precision gx(3),gx1(3)
5035 C Set lprn=.true. for debugging
5040 if (fgProcs.le.1) goto 30
5042 write (iout,'(a)') 'Contact function values:'
5044 write (iout,'(2i3,50(1x,i2,f5.2))')
5045 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5046 & j=1,num_cont_hb(i))
5049 C Caution! Following code assumes that electrostatic interactions concerning
5050 C a given atom are split among at most two processors!
5060 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5063 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5064 if (MyRank.gt.0) then
5065 C Send correlation contributions to the preceding processor
5067 nn=num_cont_hb(iatel_s)
5068 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5069 cd write (iout,*) 'The BUFFER array:'
5071 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5073 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5075 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5076 C Clear the contacts of the atom passed to the neighboring processor
5077 nn=num_cont_hb(iatel_s+1)
5079 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5081 num_cont_hb(iatel_s)=0
5083 cd write (iout,*) 'Processor ',MyID,MyRank,
5084 cd & ' is sending correlation contribution to processor',MyID-1,
5085 cd & ' msglen=',msglen
5086 cd write (*,*) 'Processor ',MyID,MyRank,
5087 cd & ' is sending correlation contribution to processor',MyID-1,
5088 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5089 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5090 cd write (iout,*) 'Processor ',MyID,
5091 cd & ' has sent correlation contribution to processor',MyID-1,
5092 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5093 cd write (*,*) 'Processor ',MyID,
5094 cd & ' has sent correlation contribution to processor',MyID-1,
5095 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5097 endif ! (MyRank.gt.0)
5101 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5102 if (MyRank.lt.fgProcs-1) then
5103 C Receive correlation contributions from the next processor
5105 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5106 cd write (iout,*) 'Processor',MyID,
5107 cd & ' is receiving correlation contribution from processor',MyID+1,
5108 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5109 cd write (*,*) 'Processor',MyID,
5110 cd & ' is receiving correlation contribution from processor',MyID+1,
5111 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5113 do while (nbytes.le.0)
5114 call mp_probe(MyID+1,CorrelType,nbytes)
5116 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5117 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5118 cd write (iout,*) 'Processor',MyID,
5119 cd & ' has received correlation contribution from processor',MyID+1,
5120 cd & ' msglen=',msglen,' nbytes=',nbytes
5121 cd write (iout,*) 'The received BUFFER array:'
5123 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5125 if (msglen.eq.msglen1) then
5126 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5127 else if (msglen.eq.msglen2) then
5128 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5129 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5132 & 'ERROR!!!! message length changed while processing correlations.'
5134 & 'ERROR!!!! message length changed while processing correlations.'
5135 call mp_stopall(Error)
5136 endif ! msglen.eq.msglen1
5137 endif ! MyRank.lt.fgProcs-1
5144 write (iout,'(a)') 'Contact function values:'
5146 write (iout,'(2i3,50(1x,i2,f5.2))')
5147 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5148 & j=1,num_cont_hb(i))
5152 C Remove the loop below after debugging !!!
5159 C Calculate the local-electrostatic correlation terms
5160 do i=iatel_s,iatel_e+1
5162 num_conti=num_cont_hb(i)
5163 num_conti1=num_cont_hb(i+1)
5168 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5169 c & ' jj=',jj,' kk=',kk
5170 if (j1.eq.j+1 .or. j1.eq.j-1) then
5171 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5172 C The system gains extra energy.
5173 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5175 else if (j1.eq.j) then
5176 C Contacts I-J and I-(J+1) occur simultaneously.
5177 C The system loses extra energy.
5178 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5183 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5184 c & ' jj=',jj,' kk=',kk
5186 C Contacts I-J and (I+1)-J occur simultaneously.
5187 C The system loses extra energy.
5188 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5195 c------------------------------------------------------------------------------
5196 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5198 C This subroutine calculates multi-body contributions to hydrogen-bonding
5199 implicit real*8 (a-h,o-z)
5200 include 'DIMENSIONS'
5201 include 'DIMENSIONS.ZSCOPT'
5202 include 'COMMON.IOUNITS'
5204 include 'COMMON.INFO'
5206 include 'COMMON.FFIELD'
5207 include 'COMMON.DERIV'
5208 include 'COMMON.INTERACT'
5209 include 'COMMON.CONTACTS'
5211 parameter (max_cont=maxconts)
5212 parameter (max_dim=2*(8*3+2))
5213 parameter (msglen1=max_cont*max_dim*4)
5214 parameter (msglen2=2*msglen1)
5215 integer source,CorrelType,CorrelID,Error
5216 double precision buffer(max_cont,max_dim)
5218 double precision gx(3),gx1(3)
5221 C Set lprn=.true. for debugging
5227 if (fgProcs.le.1) goto 30
5229 write (iout,'(a)') 'Contact function values:'
5231 write (iout,'(2i3,50(1x,i2,f5.2))')
5232 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5233 & j=1,num_cont_hb(i))
5236 C Caution! Following code assumes that electrostatic interactions concerning
5237 C a given atom are split among at most two processors!
5247 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5250 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5251 if (MyRank.gt.0) then
5252 C Send correlation contributions to the preceding processor
5254 nn=num_cont_hb(iatel_s)
5255 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5256 cd write (iout,*) 'The BUFFER array:'
5258 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5260 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5262 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5263 C Clear the contacts of the atom passed to the neighboring processor
5264 nn=num_cont_hb(iatel_s+1)
5266 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5268 num_cont_hb(iatel_s)=0
5270 cd write (iout,*) 'Processor ',MyID,MyRank,
5271 cd & ' is sending correlation contribution to processor',MyID-1,
5272 cd & ' msglen=',msglen
5273 cd write (*,*) 'Processor ',MyID,MyRank,
5274 cd & ' is sending correlation contribution to processor',MyID-1,
5275 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5276 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5277 cd write (iout,*) 'Processor ',MyID,
5278 cd & ' has sent correlation contribution to processor',MyID-1,
5279 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5280 cd write (*,*) 'Processor ',MyID,
5281 cd & ' has sent correlation contribution to processor',MyID-1,
5282 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5284 endif ! (MyRank.gt.0)
5288 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5289 if (MyRank.lt.fgProcs-1) then
5290 C Receive correlation contributions from the next processor
5292 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5293 cd write (iout,*) 'Processor',MyID,
5294 cd & ' is receiving correlation contribution from processor',MyID+1,
5295 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5296 cd write (*,*) 'Processor',MyID,
5297 cd & ' is receiving correlation contribution from processor',MyID+1,
5298 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5300 do while (nbytes.le.0)
5301 call mp_probe(MyID+1,CorrelType,nbytes)
5303 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5304 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5305 cd write (iout,*) 'Processor',MyID,
5306 cd & ' has received correlation contribution from processor',MyID+1,
5307 cd & ' msglen=',msglen,' nbytes=',nbytes
5308 cd write (iout,*) 'The received BUFFER array:'
5310 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5312 if (msglen.eq.msglen1) then
5313 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5314 else if (msglen.eq.msglen2) then
5315 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5316 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5319 & 'ERROR!!!! message length changed while processing correlations.'
5321 & 'ERROR!!!! message length changed while processing correlations.'
5322 call mp_stopall(Error)
5323 endif ! msglen.eq.msglen1
5324 endif ! MyRank.lt.fgProcs-1
5331 write (iout,'(a)') 'Contact function values:'
5333 write (iout,'(2i3,50(1x,i2,f5.2))')
5334 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5335 & j=1,num_cont_hb(i))
5341 C Remove the loop below after debugging !!!
5348 C Calculate the dipole-dipole interaction energies
5349 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5350 do i=iatel_s,iatel_e+1
5351 num_conti=num_cont_hb(i)
5358 C Calculate the local-electrostatic correlation terms
5359 do i=iatel_s,iatel_e+1
5361 num_conti=num_cont_hb(i)
5362 num_conti1=num_cont_hb(i+1)
5367 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5368 c & ' jj=',jj,' kk=',kk
5369 if (j1.eq.j+1 .or. j1.eq.j-1) then
5370 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5371 C The system gains extra energy.
5373 sqd1=dsqrt(d_cont(jj,i))
5374 sqd2=dsqrt(d_cont(kk,i1))
5375 sred_geom = sqd1*sqd2
5376 IF (sred_geom.lt.cutoff_corr) THEN
5377 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5379 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5380 c & ' jj=',jj,' kk=',kk
5381 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5382 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5384 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5385 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5388 cd write (iout,*) 'sred_geom=',sred_geom,
5389 cd & ' ekont=',ekont,' fprim=',fprimcont
5390 call calc_eello(i,j,i+1,j1,jj,kk)
5391 if (wcorr4.gt.0.0d0)
5392 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5393 if (wcorr5.gt.0.0d0)
5394 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5395 c print *,"wcorr5",ecorr5
5396 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5397 cd write(2,*)'ijkl',i,j,i+1,j1
5398 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5399 & .or. wturn6.eq.0.0d0))then
5400 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5401 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5402 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5403 cd & 'ecorr6=',ecorr6
5404 cd write (iout,'(4e15.5)') sred_geom,
5405 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5406 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5407 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5408 else if (wturn6.gt.0.0d0
5409 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5410 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5411 eturn6=eturn6+eello_turn6(i,jj,kk)
5412 cd write (2,*) 'multibody_eello:eturn6',eturn6
5416 else if (j1.eq.j) then
5417 C Contacts I-J and I-(J+1) occur simultaneously.
5418 C The system loses extra energy.
5419 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5424 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5425 c & ' jj=',jj,' kk=',kk
5427 C Contacts I-J and (I+1)-J occur simultaneously.
5428 C The system loses extra energy.
5429 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5436 c------------------------------------------------------------------------------
5437 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5438 implicit real*8 (a-h,o-z)
5439 include 'DIMENSIONS'
5440 include 'COMMON.IOUNITS'
5441 include 'COMMON.DERIV'
5442 include 'COMMON.INTERACT'
5443 include 'COMMON.CONTACTS'
5444 double precision gx(3),gx1(3)
5454 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5455 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5456 C Following 4 lines for diagnostics.
5461 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5463 c write (iout,*)'Contacts have occurred for peptide groups',
5464 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5465 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5466 C Calculate the multi-body contribution to energy.
5467 ecorr=ecorr+ekont*ees
5469 C Calculate multi-body contributions to the gradient.
5471 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5472 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5473 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5474 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5475 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5476 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5477 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5478 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5479 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5480 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5481 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5482 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5483 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5484 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5488 gradcorr(ll,m)=gradcorr(ll,m)+
5489 & ees*ekl*gacont_hbr(ll,jj,i)-
5490 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5491 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5496 gradcorr(ll,m)=gradcorr(ll,m)+
5497 & ees*eij*gacont_hbr(ll,kk,k)-
5498 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5499 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5506 C---------------------------------------------------------------------------
5507 subroutine dipole(i,j,jj)
5508 implicit real*8 (a-h,o-z)
5509 include 'DIMENSIONS'
5510 include 'DIMENSIONS.ZSCOPT'
5511 include 'COMMON.IOUNITS'
5512 include 'COMMON.CHAIN'
5513 include 'COMMON.FFIELD'
5514 include 'COMMON.DERIV'
5515 include 'COMMON.INTERACT'
5516 include 'COMMON.CONTACTS'
5517 include 'COMMON.TORSION'
5518 include 'COMMON.VAR'
5519 include 'COMMON.GEO'
5520 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5522 iti1 = itortyp(itype(i+1))
5523 if (j.lt.nres-1) then
5524 itj1 = itortyp(itype(j+1))
5529 dipi(iii,1)=Ub2(iii,i)
5530 dipderi(iii)=Ub2der(iii,i)
5531 dipi(iii,2)=b1(iii,iti1)
5532 dipj(iii,1)=Ub2(iii,j)
5533 dipderj(iii)=Ub2der(iii,j)
5534 dipj(iii,2)=b1(iii,itj1)
5538 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5541 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5544 if (.not.calc_grad) return
5549 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5553 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5558 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5559 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5561 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5563 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5565 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5569 C---------------------------------------------------------------------------
5570 subroutine calc_eello(i,j,k,l,jj,kk)
5572 C This subroutine computes matrices and vectors needed to calculate
5573 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5575 implicit real*8 (a-h,o-z)
5576 include 'DIMENSIONS'
5577 include 'DIMENSIONS.ZSCOPT'
5578 include 'COMMON.IOUNITS'
5579 include 'COMMON.CHAIN'
5580 include 'COMMON.DERIV'
5581 include 'COMMON.INTERACT'
5582 include 'COMMON.CONTACTS'
5583 include 'COMMON.TORSION'
5584 include 'COMMON.VAR'
5585 include 'COMMON.GEO'
5586 include 'COMMON.FFIELD'
5587 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5588 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5591 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5592 cd & ' jj=',jj,' kk=',kk
5593 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5596 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5597 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5600 call transpose2(aa1(1,1),aa1t(1,1))
5601 call transpose2(aa2(1,1),aa2t(1,1))
5604 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5605 & aa1tder(1,1,lll,kkk))
5606 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5607 & aa2tder(1,1,lll,kkk))
5611 C parallel orientation of the two CA-CA-CA frames.
5613 iti=itortyp(itype(i))
5617 itk1=itortyp(itype(k+1))
5618 itj=itortyp(itype(j))
5619 if (l.lt.nres-1) then
5620 itl1=itortyp(itype(l+1))
5624 C A1 kernel(j+1) A2T
5626 cd write (iout,'(3f10.5,5x,3f10.5)')
5627 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5629 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5630 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5631 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5632 C Following matrices are needed only for 6-th order cumulants
5633 IF (wcorr6.gt.0.0d0) THEN
5634 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5635 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5636 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5637 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5638 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5639 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5640 & ADtEAderx(1,1,1,1,1,1))
5642 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5643 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5644 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5645 & ADtEA1derx(1,1,1,1,1,1))
5647 C End 6-th order cumulants
5650 cd write (2,*) 'In calc_eello6'
5652 cd write (2,*) 'iii=',iii
5654 cd write (2,*) 'kkk=',kkk
5656 cd write (2,'(3(2f10.5),5x)')
5657 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5662 call transpose2(EUgder(1,1,k),auxmat(1,1))
5663 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5664 call transpose2(EUg(1,1,k),auxmat(1,1))
5665 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5666 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5670 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5671 & EAEAderx(1,1,lll,kkk,iii,1))
5675 C A1T kernel(i+1) A2
5676 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5677 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5678 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5679 C Following matrices are needed only for 6-th order cumulants
5680 IF (wcorr6.gt.0.0d0) THEN
5681 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5682 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5683 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5684 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5685 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5686 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5687 & ADtEAderx(1,1,1,1,1,2))
5688 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5689 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5690 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5691 & ADtEA1derx(1,1,1,1,1,2))
5693 C End 6-th order cumulants
5694 call transpose2(EUgder(1,1,l),auxmat(1,1))
5695 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5696 call transpose2(EUg(1,1,l),auxmat(1,1))
5697 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5698 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5702 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5703 & EAEAderx(1,1,lll,kkk,iii,2))
5708 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5709 C They are needed only when the fifth- or the sixth-order cumulants are
5711 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5712 call transpose2(AEA(1,1,1),auxmat(1,1))
5713 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5714 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5715 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5716 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5717 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5718 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5719 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5720 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5721 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5722 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5723 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5724 call transpose2(AEA(1,1,2),auxmat(1,1))
5725 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5726 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5727 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5728 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5729 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5730 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5731 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5732 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5733 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5734 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5735 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5736 C Calculate the Cartesian derivatives of the vectors.
5740 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5741 call matvec2(auxmat(1,1),b1(1,iti),
5742 & AEAb1derx(1,lll,kkk,iii,1,1))
5743 call matvec2(auxmat(1,1),Ub2(1,i),
5744 & AEAb2derx(1,lll,kkk,iii,1,1))
5745 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5746 & AEAb1derx(1,lll,kkk,iii,2,1))
5747 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5748 & AEAb2derx(1,lll,kkk,iii,2,1))
5749 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5750 call matvec2(auxmat(1,1),b1(1,itj),
5751 & AEAb1derx(1,lll,kkk,iii,1,2))
5752 call matvec2(auxmat(1,1),Ub2(1,j),
5753 & AEAb2derx(1,lll,kkk,iii,1,2))
5754 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5755 & AEAb1derx(1,lll,kkk,iii,2,2))
5756 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5757 & AEAb2derx(1,lll,kkk,iii,2,2))
5764 C Antiparallel orientation of the two CA-CA-CA frames.
5766 iti=itortyp(itype(i))
5770 itk1=itortyp(itype(k+1))
5771 itl=itortyp(itype(l))
5772 itj=itortyp(itype(j))
5773 if (j.lt.nres-1) then
5774 itj1=itortyp(itype(j+1))
5778 C A2 kernel(j-1)T A1T
5779 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5780 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5781 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5782 C Following matrices are needed only for 6-th order cumulants
5783 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5784 & j.eq.i+4 .and. l.eq.i+3)) THEN
5785 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5786 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5787 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5788 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5789 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5790 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5791 & ADtEAderx(1,1,1,1,1,1))
5792 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5793 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5794 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5795 & ADtEA1derx(1,1,1,1,1,1))
5797 C End 6-th order cumulants
5798 call transpose2(EUgder(1,1,k),auxmat(1,1))
5799 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5800 call transpose2(EUg(1,1,k),auxmat(1,1))
5801 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5802 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5806 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5807 & EAEAderx(1,1,lll,kkk,iii,1))
5811 C A2T kernel(i+1)T A1
5812 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5813 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5814 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5815 C Following matrices are needed only for 6-th order cumulants
5816 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5817 & j.eq.i+4 .and. l.eq.i+3)) THEN
5818 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5819 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5820 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5821 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5822 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5823 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5824 & ADtEAderx(1,1,1,1,1,2))
5825 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5826 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5827 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5828 & ADtEA1derx(1,1,1,1,1,2))
5830 C End 6-th order cumulants
5831 call transpose2(EUgder(1,1,j),auxmat(1,1))
5832 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5833 call transpose2(EUg(1,1,j),auxmat(1,1))
5834 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5835 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5839 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5840 & EAEAderx(1,1,lll,kkk,iii,2))
5845 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5846 C They are needed only when the fifth- or the sixth-order cumulants are
5848 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5849 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5850 call transpose2(AEA(1,1,1),auxmat(1,1))
5851 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5852 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5853 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5854 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5855 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5856 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5857 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5858 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5859 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5860 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5861 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5862 call transpose2(AEA(1,1,2),auxmat(1,1))
5863 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5864 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5865 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5866 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5867 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5868 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5869 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5870 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5871 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5872 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5873 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5874 C Calculate the Cartesian derivatives of the vectors.
5878 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5879 call matvec2(auxmat(1,1),b1(1,iti),
5880 & AEAb1derx(1,lll,kkk,iii,1,1))
5881 call matvec2(auxmat(1,1),Ub2(1,i),
5882 & AEAb2derx(1,lll,kkk,iii,1,1))
5883 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5884 & AEAb1derx(1,lll,kkk,iii,2,1))
5885 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5886 & AEAb2derx(1,lll,kkk,iii,2,1))
5887 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5888 call matvec2(auxmat(1,1),b1(1,itl),
5889 & AEAb1derx(1,lll,kkk,iii,1,2))
5890 call matvec2(auxmat(1,1),Ub2(1,l),
5891 & AEAb2derx(1,lll,kkk,iii,1,2))
5892 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5893 & AEAb1derx(1,lll,kkk,iii,2,2))
5894 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5895 & AEAb2derx(1,lll,kkk,iii,2,2))
5904 C---------------------------------------------------------------------------
5905 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5906 & KK,KKderg,AKA,AKAderg,AKAderx)
5910 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5911 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5912 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5917 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5919 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5922 cd if (lprn) write (2,*) 'In kernel'
5924 cd if (lprn) write (2,*) 'kkk=',kkk
5926 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5927 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5929 cd write (2,*) 'lll=',lll
5930 cd write (2,*) 'iii=1'
5932 cd write (2,'(3(2f10.5),5x)')
5933 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5936 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5937 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5939 cd write (2,*) 'lll=',lll
5940 cd write (2,*) 'iii=2'
5942 cd write (2,'(3(2f10.5),5x)')
5943 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5950 C---------------------------------------------------------------------------
5951 double precision function eello4(i,j,k,l,jj,kk)
5952 implicit real*8 (a-h,o-z)
5953 include 'DIMENSIONS'
5954 include 'DIMENSIONS.ZSCOPT'
5955 include 'COMMON.IOUNITS'
5956 include 'COMMON.CHAIN'
5957 include 'COMMON.DERIV'
5958 include 'COMMON.INTERACT'
5959 include 'COMMON.CONTACTS'
5960 include 'COMMON.TORSION'
5961 include 'COMMON.VAR'
5962 include 'COMMON.GEO'
5963 double precision pizda(2,2),ggg1(3),ggg2(3)
5964 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5968 cd print *,'eello4:',i,j,k,l,jj,kk
5969 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5970 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5971 cold eij=facont_hb(jj,i)
5972 cold ekl=facont_hb(kk,k)
5974 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5976 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5977 gcorr_loc(k-1)=gcorr_loc(k-1)
5978 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5980 gcorr_loc(l-1)=gcorr_loc(l-1)
5981 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5983 gcorr_loc(j-1)=gcorr_loc(j-1)
5984 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5989 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5990 & -EAEAderx(2,2,lll,kkk,iii,1)
5991 cd derx(lll,kkk,iii)=0.0d0
5995 cd gcorr_loc(l-1)=0.0d0
5996 cd gcorr_loc(j-1)=0.0d0
5997 cd gcorr_loc(k-1)=0.0d0
5999 cd write (iout,*)'Contacts have occurred for peptide groups',
6000 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6001 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6002 if (j.lt.nres-1) then
6009 if (l.lt.nres-1) then
6017 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6018 ggg1(ll)=eel4*g_contij(ll,1)
6019 ggg2(ll)=eel4*g_contij(ll,2)
6020 ghalf=0.5d0*ggg1(ll)
6022 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6023 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6024 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6025 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6026 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6027 ghalf=0.5d0*ggg2(ll)
6029 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6030 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6031 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6032 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6037 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6038 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6043 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6044 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6050 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6055 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6059 cd write (2,*) iii,gcorr_loc(iii)
6063 cd write (2,*) 'ekont',ekont
6064 cd write (iout,*) 'eello4',ekont*eel4
6067 C---------------------------------------------------------------------------
6068 double precision function eello5(i,j,k,l,jj,kk)
6069 implicit real*8 (a-h,o-z)
6070 include 'DIMENSIONS'
6071 include 'DIMENSIONS.ZSCOPT'
6072 include 'COMMON.IOUNITS'
6073 include 'COMMON.CHAIN'
6074 include 'COMMON.DERIV'
6075 include 'COMMON.INTERACT'
6076 include 'COMMON.CONTACTS'
6077 include 'COMMON.TORSION'
6078 include 'COMMON.VAR'
6079 include 'COMMON.GEO'
6080 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6081 double precision ggg1(3),ggg2(3)
6082 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6087 C /l\ / \ \ / \ / \ / C
6088 C / \ / \ \ / \ / \ / C
6089 C j| o |l1 | o | o| o | | o |o C
6090 C \ |/k\| |/ \| / |/ \| |/ \| C
6091 C \i/ \ / \ / / \ / \ C
6093 C (I) (II) (III) (IV) C
6095 C eello5_1 eello5_2 eello5_3 eello5_4 C
6097 C Antiparallel chains C
6100 C /j\ / \ \ / \ / \ / C
6101 C / \ / \ \ / \ / \ / C
6102 C j1| o |l | o | o| o | | o |o C
6103 C \ |/k\| |/ \| / |/ \| |/ \| C
6104 C \i/ \ / \ / / \ / \ C
6106 C (I) (II) (III) (IV) C
6108 C eello5_1 eello5_2 eello5_3 eello5_4 C
6110 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6112 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6113 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6118 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6120 itk=itortyp(itype(k))
6121 itl=itortyp(itype(l))
6122 itj=itortyp(itype(j))
6127 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6128 cd & eel5_3_num,eel5_4_num)
6132 derx(lll,kkk,iii)=0.0d0
6136 cd eij=facont_hb(jj,i)
6137 cd ekl=facont_hb(kk,k)
6139 cd write (iout,*)'Contacts have occurred for peptide groups',
6140 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6142 C Contribution from the graph I.
6143 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6144 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6145 call transpose2(EUg(1,1,k),auxmat(1,1))
6146 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6147 vv(1)=pizda(1,1)-pizda(2,2)
6148 vv(2)=pizda(1,2)+pizda(2,1)
6149 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6150 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6152 C Explicit gradient in virtual-dihedral angles.
6153 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6154 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6155 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6156 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6157 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6158 vv(1)=pizda(1,1)-pizda(2,2)
6159 vv(2)=pizda(1,2)+pizda(2,1)
6160 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6161 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6162 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6163 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6164 vv(1)=pizda(1,1)-pizda(2,2)
6165 vv(2)=pizda(1,2)+pizda(2,1)
6167 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6168 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6169 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6171 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6172 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6173 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6175 C Cartesian gradient
6179 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6181 vv(1)=pizda(1,1)-pizda(2,2)
6182 vv(2)=pizda(1,2)+pizda(2,1)
6183 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6184 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6185 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6192 C Contribution from graph II
6193 call transpose2(EE(1,1,itk),auxmat(1,1))
6194 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6195 vv(1)=pizda(1,1)+pizda(2,2)
6196 vv(2)=pizda(2,1)-pizda(1,2)
6197 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6198 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6200 C Explicit gradient in virtual-dihedral angles.
6201 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6202 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6203 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6204 vv(1)=pizda(1,1)+pizda(2,2)
6205 vv(2)=pizda(2,1)-pizda(1,2)
6207 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6208 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6209 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6211 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6212 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6213 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6215 C Cartesian gradient
6219 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6221 vv(1)=pizda(1,1)+pizda(2,2)
6222 vv(2)=pizda(2,1)-pizda(1,2)
6223 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6224 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6225 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6234 C Parallel orientation
6235 C Contribution from graph III
6236 call transpose2(EUg(1,1,l),auxmat(1,1))
6237 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6238 vv(1)=pizda(1,1)-pizda(2,2)
6239 vv(2)=pizda(1,2)+pizda(2,1)
6240 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6241 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6243 C Explicit gradient in virtual-dihedral angles.
6244 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6245 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6246 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6247 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6248 vv(1)=pizda(1,1)-pizda(2,2)
6249 vv(2)=pizda(1,2)+pizda(2,1)
6250 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6251 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6252 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6253 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6254 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6255 vv(1)=pizda(1,1)-pizda(2,2)
6256 vv(2)=pizda(1,2)+pizda(2,1)
6257 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6258 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6259 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6260 C Cartesian gradient
6264 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6266 vv(1)=pizda(1,1)-pizda(2,2)
6267 vv(2)=pizda(1,2)+pizda(2,1)
6268 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6269 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6270 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6276 C Contribution from graph IV
6278 call transpose2(EE(1,1,itl),auxmat(1,1))
6279 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6280 vv(1)=pizda(1,1)+pizda(2,2)
6281 vv(2)=pizda(2,1)-pizda(1,2)
6282 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6283 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6285 C Explicit gradient in virtual-dihedral angles.
6286 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6287 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6288 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6289 vv(1)=pizda(1,1)+pizda(2,2)
6290 vv(2)=pizda(2,1)-pizda(1,2)
6291 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6292 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6293 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6294 C Cartesian gradient
6298 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6300 vv(1)=pizda(1,1)+pizda(2,2)
6301 vv(2)=pizda(2,1)-pizda(1,2)
6302 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6303 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6304 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6310 C Antiparallel orientation
6311 C Contribution from graph III
6313 call transpose2(EUg(1,1,j),auxmat(1,1))
6314 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6315 vv(1)=pizda(1,1)-pizda(2,2)
6316 vv(2)=pizda(1,2)+pizda(2,1)
6317 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6318 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6320 C Explicit gradient in virtual-dihedral angles.
6321 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6322 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6323 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6324 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6325 vv(1)=pizda(1,1)-pizda(2,2)
6326 vv(2)=pizda(1,2)+pizda(2,1)
6327 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6328 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6329 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6330 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6331 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6332 vv(1)=pizda(1,1)-pizda(2,2)
6333 vv(2)=pizda(1,2)+pizda(2,1)
6334 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6335 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6336 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6337 C Cartesian gradient
6341 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6343 vv(1)=pizda(1,1)-pizda(2,2)
6344 vv(2)=pizda(1,2)+pizda(2,1)
6345 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6346 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6347 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6353 C Contribution from graph IV
6355 call transpose2(EE(1,1,itj),auxmat(1,1))
6356 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6357 vv(1)=pizda(1,1)+pizda(2,2)
6358 vv(2)=pizda(2,1)-pizda(1,2)
6359 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6360 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6362 C Explicit gradient in virtual-dihedral angles.
6363 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6364 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6365 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6366 vv(1)=pizda(1,1)+pizda(2,2)
6367 vv(2)=pizda(2,1)-pizda(1,2)
6368 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6369 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6370 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6371 C Cartesian gradient
6375 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6377 vv(1)=pizda(1,1)+pizda(2,2)
6378 vv(2)=pizda(2,1)-pizda(1,2)
6379 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6380 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6381 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6388 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6389 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6390 cd write (2,*) 'ijkl',i,j,k,l
6391 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6392 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6394 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6395 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6396 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6397 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6399 if (j.lt.nres-1) then
6406 if (l.lt.nres-1) then
6416 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6418 ggg1(ll)=eel5*g_contij(ll,1)
6419 ggg2(ll)=eel5*g_contij(ll,2)
6420 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6421 ghalf=0.5d0*ggg1(ll)
6423 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6424 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6425 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6426 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6427 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6428 ghalf=0.5d0*ggg2(ll)
6430 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6431 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6432 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6433 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6438 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6439 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6444 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6445 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6451 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6456 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6460 cd write (2,*) iii,g_corr5_loc(iii)
6464 cd write (2,*) 'ekont',ekont
6465 cd write (iout,*) 'eello5',ekont*eel5
6468 c--------------------------------------------------------------------------
6469 double precision function eello6(i,j,k,l,jj,kk)
6470 implicit real*8 (a-h,o-z)
6471 include 'DIMENSIONS'
6472 include 'DIMENSIONS.ZSCOPT'
6473 include 'COMMON.IOUNITS'
6474 include 'COMMON.CHAIN'
6475 include 'COMMON.DERIV'
6476 include 'COMMON.INTERACT'
6477 include 'COMMON.CONTACTS'
6478 include 'COMMON.TORSION'
6479 include 'COMMON.VAR'
6480 include 'COMMON.GEO'
6481 include 'COMMON.FFIELD'
6482 double precision ggg1(3),ggg2(3)
6483 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6488 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6496 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6497 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6501 derx(lll,kkk,iii)=0.0d0
6505 cd eij=facont_hb(jj,i)
6506 cd ekl=facont_hb(kk,k)
6512 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6513 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6514 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6515 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6516 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6517 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6519 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6520 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6521 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6522 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6523 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6524 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6528 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6530 C If turn contributions are considered, they will be handled separately.
6531 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6532 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6533 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6534 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6535 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6536 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6537 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6540 if (j.lt.nres-1) then
6547 if (l.lt.nres-1) then
6555 ggg1(ll)=eel6*g_contij(ll,1)
6556 ggg2(ll)=eel6*g_contij(ll,2)
6557 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6558 ghalf=0.5d0*ggg1(ll)
6560 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6561 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6562 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6563 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6564 ghalf=0.5d0*ggg2(ll)
6565 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6567 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6568 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6569 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6570 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6575 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6576 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6581 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6582 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6588 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6593 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6597 cd write (2,*) iii,g_corr6_loc(iii)
6601 cd write (2,*) 'ekont',ekont
6602 cd write (iout,*) 'eello6',ekont*eel6
6605 c--------------------------------------------------------------------------
6606 double precision function eello6_graph1(i,j,k,l,imat,swap)
6607 implicit real*8 (a-h,o-z)
6608 include 'DIMENSIONS'
6609 include 'DIMENSIONS.ZSCOPT'
6610 include 'COMMON.IOUNITS'
6611 include 'COMMON.CHAIN'
6612 include 'COMMON.DERIV'
6613 include 'COMMON.INTERACT'
6614 include 'COMMON.CONTACTS'
6615 include 'COMMON.TORSION'
6616 include 'COMMON.VAR'
6617 include 'COMMON.GEO'
6618 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6622 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6624 C Parallel Antiparallel C
6630 C \ j|/k\| / \ |/k\|l / C
6635 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6636 itk=itortyp(itype(k))
6637 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6638 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6639 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6640 call transpose2(EUgC(1,1,k),auxmat(1,1))
6641 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6642 vv1(1)=pizda1(1,1)-pizda1(2,2)
6643 vv1(2)=pizda1(1,2)+pizda1(2,1)
6644 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6645 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6646 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6647 s5=scalar2(vv(1),Dtobr2(1,i))
6648 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6649 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6650 if (.not. calc_grad) return
6651 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6652 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6653 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6654 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6655 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6656 & +scalar2(vv(1),Dtobr2der(1,i)))
6657 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6658 vv1(1)=pizda1(1,1)-pizda1(2,2)
6659 vv1(2)=pizda1(1,2)+pizda1(2,1)
6660 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6661 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6663 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6664 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6665 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6666 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6667 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6669 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6670 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6671 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6672 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6673 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6675 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6676 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6677 vv1(1)=pizda1(1,1)-pizda1(2,2)
6678 vv1(2)=pizda1(1,2)+pizda1(2,1)
6679 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6680 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6681 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6682 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6691 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6692 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6693 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6694 call transpose2(EUgC(1,1,k),auxmat(1,1))
6695 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6697 vv1(1)=pizda1(1,1)-pizda1(2,2)
6698 vv1(2)=pizda1(1,2)+pizda1(2,1)
6699 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6700 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6701 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6702 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6703 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6704 s5=scalar2(vv(1),Dtobr2(1,i))
6705 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6711 c----------------------------------------------------------------------------
6712 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6713 implicit real*8 (a-h,o-z)
6714 include 'DIMENSIONS'
6715 include 'DIMENSIONS.ZSCOPT'
6716 include 'COMMON.IOUNITS'
6717 include 'COMMON.CHAIN'
6718 include 'COMMON.DERIV'
6719 include 'COMMON.INTERACT'
6720 include 'COMMON.CONTACTS'
6721 include 'COMMON.TORSION'
6722 include 'COMMON.VAR'
6723 include 'COMMON.GEO'
6725 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6726 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6729 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6731 C Parallel Antiparallel C
6737 C \ j|/k\| \ |/k\|l C
6742 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6743 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6744 C AL 7/4/01 s1 would occur in the sixth-order moment,
6745 C but not in a cluster cumulant
6747 s1=dip(1,jj,i)*dip(1,kk,k)
6749 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6750 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6751 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6752 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6753 call transpose2(EUg(1,1,k),auxmat(1,1))
6754 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6755 vv(1)=pizda(1,1)-pizda(2,2)
6756 vv(2)=pizda(1,2)+pizda(2,1)
6757 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6758 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6760 eello6_graph2=-(s1+s2+s3+s4)
6762 eello6_graph2=-(s2+s3+s4)
6765 if (.not. calc_grad) return
6766 C Derivatives in gamma(i-1)
6769 s1=dipderg(1,jj,i)*dip(1,kk,k)
6771 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6772 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6773 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6774 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6776 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6778 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6780 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6782 C Derivatives in gamma(k-1)
6784 s1=dip(1,jj,i)*dipderg(1,kk,k)
6786 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6787 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6788 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6789 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6790 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6791 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6792 vv(1)=pizda(1,1)-pizda(2,2)
6793 vv(2)=pizda(1,2)+pizda(2,1)
6794 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6796 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6798 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6800 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6801 C Derivatives in gamma(j-1) or gamma(l-1)
6804 s1=dipderg(3,jj,i)*dip(1,kk,k)
6806 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6807 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6808 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6809 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6810 vv(1)=pizda(1,1)-pizda(2,2)
6811 vv(2)=pizda(1,2)+pizda(2,1)
6812 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6815 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6817 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6820 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6821 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6823 C Derivatives in gamma(l-1) or gamma(j-1)
6826 s1=dip(1,jj,i)*dipderg(3,kk,k)
6828 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6829 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6830 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6831 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6832 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6833 vv(1)=pizda(1,1)-pizda(2,2)
6834 vv(2)=pizda(1,2)+pizda(2,1)
6835 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6838 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6840 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6843 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6844 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6846 C Cartesian derivatives.
6848 write (2,*) 'In eello6_graph2'
6850 write (2,*) 'iii=',iii
6852 write (2,*) 'kkk=',kkk
6854 write (2,'(3(2f10.5),5x)')
6855 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6865 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6867 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6870 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6872 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6873 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6875 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6876 call transpose2(EUg(1,1,k),auxmat(1,1))
6877 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6879 vv(1)=pizda(1,1)-pizda(2,2)
6880 vv(2)=pizda(1,2)+pizda(2,1)
6881 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6882 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6884 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6886 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6889 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6891 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6898 c----------------------------------------------------------------------------
6899 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6900 implicit real*8 (a-h,o-z)
6901 include 'DIMENSIONS'
6902 include 'DIMENSIONS.ZSCOPT'
6903 include 'COMMON.IOUNITS'
6904 include 'COMMON.CHAIN'
6905 include 'COMMON.DERIV'
6906 include 'COMMON.INTERACT'
6907 include 'COMMON.CONTACTS'
6908 include 'COMMON.TORSION'
6909 include 'COMMON.VAR'
6910 include 'COMMON.GEO'
6911 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6913 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6915 C Parallel Antiparallel C
6921 C j|/k\| / |/k\|l / C
6926 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6928 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6929 C energy moment and not to the cluster cumulant.
6930 iti=itortyp(itype(i))
6931 if (j.lt.nres-1) then
6932 itj1=itortyp(itype(j+1))
6936 itk=itortyp(itype(k))
6937 itk1=itortyp(itype(k+1))
6938 if (l.lt.nres-1) then
6939 itl1=itortyp(itype(l+1))
6944 s1=dip(4,jj,i)*dip(4,kk,k)
6946 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6947 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6948 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6949 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6950 call transpose2(EE(1,1,itk),auxmat(1,1))
6951 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6952 vv(1)=pizda(1,1)+pizda(2,2)
6953 vv(2)=pizda(2,1)-pizda(1,2)
6954 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6955 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6957 eello6_graph3=-(s1+s2+s3+s4)
6959 eello6_graph3=-(s2+s3+s4)
6962 if (.not. calc_grad) return
6963 C Derivatives in gamma(k-1)
6964 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6965 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6966 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6967 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6968 C Derivatives in gamma(l-1)
6969 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6970 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6971 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6972 vv(1)=pizda(1,1)+pizda(2,2)
6973 vv(2)=pizda(2,1)-pizda(1,2)
6974 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6975 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6976 C Cartesian derivatives.
6982 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6984 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6987 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6989 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6990 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6992 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6993 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6995 vv(1)=pizda(1,1)+pizda(2,2)
6996 vv(2)=pizda(2,1)-pizda(1,2)
6997 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6999 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7001 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7004 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7006 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7008 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7014 c----------------------------------------------------------------------------
7015 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7016 implicit real*8 (a-h,o-z)
7017 include 'DIMENSIONS'
7018 include 'DIMENSIONS.ZSCOPT'
7019 include 'COMMON.IOUNITS'
7020 include 'COMMON.CHAIN'
7021 include 'COMMON.DERIV'
7022 include 'COMMON.INTERACT'
7023 include 'COMMON.CONTACTS'
7024 include 'COMMON.TORSION'
7025 include 'COMMON.VAR'
7026 include 'COMMON.GEO'
7027 include 'COMMON.FFIELD'
7028 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7029 & auxvec1(2),auxmat1(2,2)
7031 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7033 C Parallel Antiparallel C
7039 C \ j|/k\| \ |/k\|l C
7044 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7046 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7047 C energy moment and not to the cluster cumulant.
7048 cd write (2,*) 'eello_graph4: wturn6',wturn6
7049 iti=itortyp(itype(i))
7050 itj=itortyp(itype(j))
7051 if (j.lt.nres-1) then
7052 itj1=itortyp(itype(j+1))
7056 itk=itortyp(itype(k))
7057 if (k.lt.nres-1) then
7058 itk1=itortyp(itype(k+1))
7062 itl=itortyp(itype(l))
7063 if (l.lt.nres-1) then
7064 itl1=itortyp(itype(l+1))
7068 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7069 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7070 cd & ' itl',itl,' itl1',itl1
7073 s1=dip(3,jj,i)*dip(3,kk,k)
7075 s1=dip(2,jj,j)*dip(2,kk,l)
7078 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7079 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7081 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7082 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7084 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7085 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7087 call transpose2(EUg(1,1,k),auxmat(1,1))
7088 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7089 vv(1)=pizda(1,1)-pizda(2,2)
7090 vv(2)=pizda(2,1)+pizda(1,2)
7091 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7092 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7094 eello6_graph4=-(s1+s2+s3+s4)
7096 eello6_graph4=-(s2+s3+s4)
7098 if (.not. calc_grad) return
7099 C Derivatives in gamma(i-1)
7103 s1=dipderg(2,jj,i)*dip(3,kk,k)
7105 s1=dipderg(4,jj,j)*dip(2,kk,l)
7108 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7110 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7111 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7113 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7114 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7116 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7117 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7118 cd write (2,*) 'turn6 derivatives'
7120 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7122 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7126 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7128 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7132 C Derivatives in gamma(k-1)
7135 s1=dip(3,jj,i)*dipderg(2,kk,k)
7137 s1=dip(2,jj,j)*dipderg(4,kk,l)
7140 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7141 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7143 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7144 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7146 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7147 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7149 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7150 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7151 vv(1)=pizda(1,1)-pizda(2,2)
7152 vv(2)=pizda(2,1)+pizda(1,2)
7153 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7154 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7156 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7158 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7162 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7164 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7167 C Derivatives in gamma(j-1) or gamma(l-1)
7168 if (l.eq.j+1 .and. l.gt.1) then
7169 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7170 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7171 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7172 vv(1)=pizda(1,1)-pizda(2,2)
7173 vv(2)=pizda(2,1)+pizda(1,2)
7174 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7175 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7176 else if (j.gt.1) then
7177 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7178 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7179 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7180 vv(1)=pizda(1,1)-pizda(2,2)
7181 vv(2)=pizda(2,1)+pizda(1,2)
7182 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7183 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7184 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7186 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7189 C Cartesian derivatives.
7196 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7198 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7202 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7204 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7208 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7210 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7212 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7213 & b1(1,itj1),auxvec(1))
7214 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7216 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7217 & b1(1,itl1),auxvec(1))
7218 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7220 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7222 vv(1)=pizda(1,1)-pizda(2,2)
7223 vv(2)=pizda(2,1)+pizda(1,2)
7224 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7226 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7228 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7231 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7234 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7237 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7239 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7241 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7245 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7247 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7250 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7252 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7260 c----------------------------------------------------------------------------
7261 double precision function eello_turn6(i,jj,kk)
7262 implicit real*8 (a-h,o-z)
7263 include 'DIMENSIONS'
7264 include 'DIMENSIONS.ZSCOPT'
7265 include 'COMMON.IOUNITS'
7266 include 'COMMON.CHAIN'
7267 include 'COMMON.DERIV'
7268 include 'COMMON.INTERACT'
7269 include 'COMMON.CONTACTS'
7270 include 'COMMON.TORSION'
7271 include 'COMMON.VAR'
7272 include 'COMMON.GEO'
7273 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7274 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7276 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7277 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7278 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7279 C the respective energy moment and not to the cluster cumulant.
7284 iti=itortyp(itype(i))
7285 itk=itortyp(itype(k))
7286 itk1=itortyp(itype(k+1))
7287 itl=itortyp(itype(l))
7288 itj=itortyp(itype(j))
7289 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7290 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7291 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7296 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7298 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7302 derx_turn(lll,kkk,iii)=0.0d0
7309 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7311 cd write (2,*) 'eello6_5',eello6_5
7313 call transpose2(AEA(1,1,1),auxmat(1,1))
7314 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7315 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7316 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7320 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7321 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7322 s2 = scalar2(b1(1,itk),vtemp1(1))
7324 call transpose2(AEA(1,1,2),atemp(1,1))
7325 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7326 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7327 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7331 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7332 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7333 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7335 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7336 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7337 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7338 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7339 ss13 = scalar2(b1(1,itk),vtemp4(1))
7340 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7344 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7350 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7352 C Derivatives in gamma(i+2)
7354 call transpose2(AEA(1,1,1),auxmatd(1,1))
7355 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7356 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7357 call transpose2(AEAderg(1,1,2),atempd(1,1))
7358 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7359 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7363 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7364 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7365 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7371 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7372 C Derivatives in gamma(i+3)
7374 call transpose2(AEA(1,1,1),auxmatd(1,1))
7375 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7376 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7377 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7381 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7382 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7383 s2d = scalar2(b1(1,itk),vtemp1d(1))
7385 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7386 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7388 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7390 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7391 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7392 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7402 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7403 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7405 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7406 & -0.5d0*ekont*(s2d+s12d)
7408 C Derivatives in gamma(i+4)
7409 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7410 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7411 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7413 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7414 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7415 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7425 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7427 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7429 C Derivatives in gamma(i+5)
7431 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7432 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7433 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7437 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7438 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7439 s2d = scalar2(b1(1,itk),vtemp1d(1))
7441 call transpose2(AEA(1,1,2),atempd(1,1))
7442 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7443 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7447 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7448 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7450 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7451 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7452 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7462 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7463 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7465 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7466 & -0.5d0*ekont*(s2d+s12d)
7468 C Cartesian derivatives
7473 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7474 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7475 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7479 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7480 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7482 s2d = scalar2(b1(1,itk),vtemp1d(1))
7484 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7485 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7486 s8d = -(atempd(1,1)+atempd(2,2))*
7487 & scalar2(cc(1,1,itl),vtemp2(1))
7491 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7493 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7494 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7501 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7504 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7508 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7509 & - 0.5d0*(s8d+s12d)
7511 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7520 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7522 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7523 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7524 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7525 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7526 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7528 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7529 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7530 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7534 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7535 cd & 16*eel_turn6_num
7537 if (j.lt.nres-1) then
7544 if (l.lt.nres-1) then
7552 ggg1(ll)=eel_turn6*g_contij(ll,1)
7553 ggg2(ll)=eel_turn6*g_contij(ll,2)
7554 ghalf=0.5d0*ggg1(ll)
7556 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7557 & +ekont*derx_turn(ll,2,1)
7558 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7559 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7560 & +ekont*derx_turn(ll,4,1)
7561 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7562 ghalf=0.5d0*ggg2(ll)
7564 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7565 & +ekont*derx_turn(ll,2,2)
7566 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7567 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7568 & +ekont*derx_turn(ll,4,2)
7569 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7574 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7579 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7585 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7590 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7594 cd write (2,*) iii,g_corr6_loc(iii)
7597 eello_turn6=ekont*eel_turn6
7598 cd write (2,*) 'ekont',ekont
7599 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7602 crc-------------------------------------------------
7603 SUBROUTINE MATVEC2(A1,V1,V2)
7604 implicit real*8 (a-h,o-z)
7605 include 'DIMENSIONS'
7606 DIMENSION A1(2,2),V1(2),V2(2)
7610 c 3 VI=VI+A1(I,K)*V1(K)
7614 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7615 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7620 C---------------------------------------
7621 SUBROUTINE MATMAT2(A1,A2,A3)
7622 implicit real*8 (a-h,o-z)
7623 include 'DIMENSIONS'
7624 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7625 c DIMENSION AI3(2,2)
7629 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7635 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7636 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7637 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7638 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7646 c-------------------------------------------------------------------------
7647 double precision function scalar2(u,v)
7649 double precision u(2),v(2)
7652 scalar2=u(1)*v(1)+u(2)*v(2)
7656 C-----------------------------------------------------------------------------
7658 subroutine transpose2(a,at)
7660 double precision a(2,2),at(2,2)
7667 c--------------------------------------------------------------------------
7668 subroutine transpose(n,a,at)
7671 double precision a(n,n),at(n,n)
7679 C---------------------------------------------------------------------------
7680 subroutine prodmat3(a1,a2,kk,transp,prod)
7683 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7685 crc double precision auxmat(2,2),prod_(2,2)
7688 crc call transpose2(kk(1,1),auxmat(1,1))
7689 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7690 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7692 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7693 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7694 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7695 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7696 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7697 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7698 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7699 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7702 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7703 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7705 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7706 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7707 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7708 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7709 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7710 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7711 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7712 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7715 c call transpose2(a2(1,1),a2t(1,1))
7718 crc print *,((prod_(i,j),i=1,2),j=1,2)
7719 crc print *,((prod(i,j),i=1,2),j=1,2)
7723 C-----------------------------------------------------------------------------
7724 double precision function scalar(u,v)
7726 double precision u(3),v(3)