1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
70 call ebend(ebe,ethetacnstr)
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
157 energia(24)=ethetacnstr
161 if (isnan(etot).ne.0) energia(0)=1.0d+99
163 if (isnan(etot)) energia(0)=1.0d+99
168 idumm=proc_proc(etot,i)
170 call proc_proc(etot,i)
172 if(i.eq.1)energia(0)=1.0d+99
179 C Sum up the components of the Cartesian gradient.
184 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
185 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
187 & wstrain*ghpbc(j,i)+
188 & wcorr*fact(3)*gradcorr(j,i)+
189 & wel_loc*fact(2)*gel_loc(j,i)+
190 & wturn3*fact(2)*gcorr3_turn(j,i)+
191 & wturn4*fact(3)*gcorr4_turn(j,i)+
192 & wcorr5*fact(4)*gradcorr5(j,i)+
193 & wcorr6*fact(5)*gradcorr6(j,i)+
194 & wturn6*fact(5)*gcorr6_turn(j,i)+
195 & wsccor*fact(2)*gsccorc(j,i)
196 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
198 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
199 & wsccor*fact(2)*gsccorx(j,i)
204 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
205 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
207 & wcorr*fact(3)*gradcorr(j,i)+
208 & wel_loc*fact(2)*gel_loc(j,i)+
209 & wturn3*fact(2)*gcorr3_turn(j,i)+
210 & wturn4*fact(3)*gcorr4_turn(j,i)+
211 & wcorr5*fact(4)*gradcorr5(j,i)+
212 & wcorr6*fact(5)*gradcorr6(j,i)+
213 & wturn6*fact(5)*gcorr6_turn(j,i)+
214 & wsccor*fact(2)*gsccorc(j,i)
215 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
217 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
218 & wsccor*fact(1)*gsccorx(j,i)
225 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
226 & +wcorr5*fact(4)*g_corr5_loc(i)
227 & +wcorr6*fact(5)*g_corr6_loc(i)
228 & +wturn4*fact(3)*gel_loc_turn4(i)
229 & +wturn3*fact(2)*gel_loc_turn3(i)
230 & +wturn6*fact(5)*gel_loc_turn6(i)
231 & +wel_loc*fact(2)*gel_loc_loc(i)
232 c & +wsccor*fact(1)*gsccor_loc(i)
236 if (dyn_ss) call dyn_set_nss
239 C------------------------------------------------------------------------
240 subroutine enerprint(energia,fact)
241 implicit real*8 (a-h,o-z)
243 include 'sizesclu.dat'
244 include 'COMMON.IOUNITS'
245 include 'COMMON.FFIELD'
246 include 'COMMON.SBRIDGE'
247 double precision energia(0:max_ene),fact(6)
249 evdw=energia(1)+fact(6)*energia(21)
251 evdw2=energia(2)+energia(17)
263 eello_turn3=energia(8)
264 eello_turn4=energia(9)
265 eello_turn6=energia(10)
272 edihcnstr=energia(20)
274 ethetacnstr=energia(24)
276 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
278 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
279 & etors_d,wtor_d*fact(2),ehpb,wstrain,
280 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
281 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
282 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
283 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,etot
284 10 format (/'Virtual-chain energies:'//
285 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
286 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
287 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
288 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
289 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
290 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
291 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
292 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
293 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
294 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
295 & ' (SS bridges & dist. cnstr.)'/
296 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
297 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
298 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
299 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
300 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
301 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
302 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
303 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
304 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
305 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
306 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
307 & 'ETOT= ',1pE16.6,' (total)')
309 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
310 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
311 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
312 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
313 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
314 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
315 & edihcnstr,ethetacnstr,ebr*nss,etot
316 10 format (/'Virtual-chain energies:'//
317 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
318 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
319 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
320 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
321 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
322 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
323 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
324 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
325 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
326 & ' (SS bridges & dist. cnstr.)'/
327 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
328 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
329 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
330 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
331 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
332 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
333 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
334 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
335 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
336 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
337 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
338 & 'ETOT= ',1pE16.6,' (total)')
342 C-----------------------------------------------------------------------
343 subroutine elj(evdw,evdw_t)
345 C This subroutine calculates the interaction energy of nonbonded side chains
346 C assuming the LJ potential of interaction.
348 implicit real*8 (a-h,o-z)
350 include 'sizesclu.dat'
351 include "DIMENSIONS.COMPAR"
352 parameter (accur=1.0d-10)
355 include 'COMMON.LOCAL'
356 include 'COMMON.CHAIN'
357 include 'COMMON.DERIV'
358 include 'COMMON.INTERACT'
359 include 'COMMON.TORSION'
360 include 'COMMON.SBRIDGE'
361 include 'COMMON.NAMES'
362 include 'COMMON.IOUNITS'
363 include 'COMMON.CONTACTS'
367 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
368 c ROZNICA DODANE Z WHAM
371 c eneps_temp(j,i)=0.0d0
380 if (itypi.eq.ntyp1) cycle
381 itypi1=iabs(itype(i+1))
388 C Calculate SC interaction energy.
391 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
392 cd & 'iend=',iend(i,iint)
393 do j=istart(i,iint),iend(i,iint)
395 if (itypj.eq.ntyp1) cycle
399 C Change 12/1/95 to calculate four-body interactions
400 rij=xj*xj+yj*yj+zj*zj
402 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
403 eps0ij=eps(itypi,itypj)
405 e1=fac*fac*aa(itypi,itypj)
406 e2=fac*bb(itypi,itypj)
408 ij=icant(itypi,itypj)
410 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
411 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
414 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
415 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
416 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
417 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
418 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
419 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
420 if (bb(itypi,itypj).gt.0.0d0) then
427 C Calculate the components of the gradient in DC and X
429 fac=-rrij*(e1+evdwij)
434 gvdwx(k,i)=gvdwx(k,i)-gg(k)
435 gvdwx(k,j)=gvdwx(k,j)+gg(k)
439 gvdwc(l,k)=gvdwc(l,k)+gg(l)
444 C 12/1/95, revised on 5/20/97
446 C Calculate the contact function. The ith column of the array JCONT will
447 C contain the numbers of atoms that make contacts with the atom I (of numbers
448 C greater than I). The arrays FACONT and GACONT will contain the values of
449 C the contact function and its derivative.
451 C Uncomment next line, if the correlation interactions include EVDW explicitly.
452 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
453 C Uncomment next line, if the correlation interactions are contact function only
454 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
456 sigij=sigma(itypi,itypj)
457 r0ij=rs0(itypi,itypj)
459 C Check whether the SC's are not too far to make a contact.
462 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
463 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
465 if (fcont.gt.0.0D0) then
466 C If the SC-SC distance if close to sigma, apply spline.
467 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
468 cAdam & fcont1,fprimcont1)
469 cAdam fcont1=1.0d0-fcont1
470 cAdam if (fcont1.gt.0.0d0) then
471 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
472 cAdam fcont=fcont*fcont1
474 C Uncomment following 4 lines to have the geometric average of the epsilon0's
475 cga eps0ij=1.0d0/dsqrt(eps0ij)
477 cga gg(k)=gg(k)*eps0ij
479 cga eps0ij=-evdwij*eps0ij
480 C Uncomment for AL's type of SC correlation interactions.
482 num_conti=num_conti+1
484 facont(num_conti,i)=fcont*eps0ij
485 fprimcont=eps0ij*fprimcont/rij
487 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
488 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
489 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
490 C Uncomment following 3 lines for Skolnick's type of SC correlation.
491 gacont(1,num_conti,i)=-fprimcont*xj
492 gacont(2,num_conti,i)=-fprimcont*yj
493 gacont(3,num_conti,i)=-fprimcont*zj
494 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
495 cd write (iout,'(2i3,3f10.5)')
496 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
502 num_cont(i)=num_conti
507 gvdwc(j,i)=expon*gvdwc(j,i)
508 gvdwx(j,i)=expon*gvdwx(j,i)
512 C******************************************************************************
516 C To save time, the factor of EXPON has been extracted from ALL components
517 C of GVDWC and GRADX. Remember to multiply them by this factor before further
520 C******************************************************************************
523 C-----------------------------------------------------------------------------
524 subroutine eljk(evdw,evdw_t)
526 C This subroutine calculates the interaction energy of nonbonded side chains
527 C assuming the LJK potential of interaction.
529 implicit real*8 (a-h,o-z)
531 include 'sizesclu.dat'
532 include "DIMENSIONS.COMPAR"
535 include 'COMMON.LOCAL'
536 include 'COMMON.CHAIN'
537 include 'COMMON.DERIV'
538 include 'COMMON.INTERACT'
539 include 'COMMON.IOUNITS'
540 include 'COMMON.NAMES'
545 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
550 if (itypi.eq.ntyp1) cycle
551 itypi1=iabs(itype(i+1))
556 C Calculate SC interaction energy.
559 do j=istart(i,iint),iend(i,iint)
561 if (itypj.eq.ntyp1) cycle
565 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
567 e_augm=augm(itypi,itypj)*fac_augm
570 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
571 fac=r_shift_inv**expon
572 e1=fac*fac*aa(itypi,itypj)
573 e2=fac*bb(itypi,itypj)
575 ij=icant(itypi,itypj)
576 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
577 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
578 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
579 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
580 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
581 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
582 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
583 if (bb(itypi,itypj).gt.0.0d0) then
590 C Calculate the components of the gradient in DC and X
592 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
597 gvdwx(k,i)=gvdwx(k,i)-gg(k)
598 gvdwx(k,j)=gvdwx(k,j)+gg(k)
602 gvdwc(l,k)=gvdwc(l,k)+gg(l)
612 gvdwc(j,i)=expon*gvdwc(j,i)
613 gvdwx(j,i)=expon*gvdwx(j,i)
619 C-----------------------------------------------------------------------------
620 subroutine ebp(evdw,evdw_t)
622 C This subroutine calculates the interaction energy of nonbonded side chains
623 C assuming the Berne-Pechukas potential of interaction.
625 implicit real*8 (a-h,o-z)
627 include 'sizesclu.dat'
628 include "DIMENSIONS.COMPAR"
631 include 'COMMON.LOCAL'
632 include 'COMMON.CHAIN'
633 include 'COMMON.DERIV'
634 include 'COMMON.NAMES'
635 include 'COMMON.INTERACT'
636 include 'COMMON.IOUNITS'
637 include 'COMMON.CALC'
639 c double precision rrsave(maxdim)
645 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
646 c if (icall.eq.0) then
654 if (itypi.eq.ntyp1) cycle
655 itypi1=iabs(itype(i+1))
659 dxi=dc_norm(1,nres+i)
660 dyi=dc_norm(2,nres+i)
661 dzi=dc_norm(3,nres+i)
662 dsci_inv=vbld_inv(i+nres)
664 C Calculate SC interaction energy.
667 do j=istart(i,iint),iend(i,iint)
670 if (itypj.eq.ntyp1) cycle
671 dscj_inv=vbld_inv(j+nres)
672 chi1=chi(itypi,itypj)
673 chi2=chi(itypj,itypi)
680 alf12=0.5D0*(alf1+alf2)
681 C For diagnostics only!!!
694 dxj=dc_norm(1,nres+j)
695 dyj=dc_norm(2,nres+j)
696 dzj=dc_norm(3,nres+j)
697 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
698 cd if (icall.eq.0) then
704 C Calculate the angle-dependent terms of energy & contributions to derivatives.
706 C Calculate whole angle-dependent part of epsilon and contributions
708 fac=(rrij*sigsq)**expon2
709 e1=fac*fac*aa(itypi,itypj)
710 e2=fac*bb(itypi,itypj)
711 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
712 eps2der=evdwij*eps3rt
713 eps3der=evdwij*eps2rt
714 evdwij=evdwij*eps2rt*eps3rt
715 ij=icant(itypi,itypj)
716 aux=eps1*eps2rt**2*eps3rt**2
717 if (bb(itypi,itypj).gt.0.0d0) then
724 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
725 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
726 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
727 cd & restyp(itypi),i,restyp(itypj),j,
728 cd & epsi,sigm,chi1,chi2,chip1,chip2,
729 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
730 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
733 C Calculate gradient components.
734 e1=e1*eps1*eps2rt**2*eps3rt**2
735 fac=-expon*(e1+evdwij)
738 C Calculate radial part of the gradient
742 C Calculate the angular part of the gradient and sum add the contributions
743 C to the appropriate components of the Cartesian gradient.
752 C-----------------------------------------------------------------------------
753 subroutine egb(evdw,evdw_t)
755 C This subroutine calculates the interaction energy of nonbonded side chains
756 C assuming the Gay-Berne potential of interaction.
758 implicit real*8 (a-h,o-z)
760 include 'sizesclu.dat'
761 include "DIMENSIONS.COMPAR"
764 include 'COMMON.LOCAL'
765 include 'COMMON.CHAIN'
766 include 'COMMON.DERIV'
767 include 'COMMON.NAMES'
768 include 'COMMON.INTERACT'
769 include 'COMMON.IOUNITS'
770 include 'COMMON.CALC'
771 include 'COMMON.SBRIDGE'
776 logical energy_dec /.true./
777 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
781 c if (icall.gt.0) lprn=.true.
785 if (itypi.eq.ntyp1) cycle
786 itypi1=iabs(itype(i+1))
790 dxi=dc_norm(1,nres+i)
791 dyi=dc_norm(2,nres+i)
792 dzi=dc_norm(3,nres+i)
793 dsci_inv=vbld_inv(i+nres)
795 C Calculate SC interaction energy.
798 do j=istart(i,iint),iend(i,iint)
799 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
801 c write(iout,*) "PRZED ZWYKLE", evdwij
802 call dyn_ssbond_ene(i,j,evdwij)
803 c write(iout,*) "PO ZWYKLE", evdwij
806 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
807 & 'evdw',i,j,evdwij,' ss'
808 C triple bond artifac removal
809 do k=j+1,iend(i,iint)
810 C search over all next residues
811 if (dyn_ss_mask(k)) then
812 C check if they are cysteins
813 C write(iout,*) 'k=',k
815 c write(iout,*) "PRZED TRI", evdwij
816 evdwij_przed_tri=evdwij
817 call triple_ssbond_ene(i,j,k,evdwij)
818 c if(evdwij_przed_tri.ne.evdwij) then
819 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
822 c write(iout,*) "PO TRI", evdwij
823 C call the energy function that removes the artifical triple disulfide
824 C bond the soubroutine is located in ssMD.F
826 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
827 & 'evdw',i,j,evdwij,'tss'
833 if (itypj.eq.ntyp1) cycle
834 dscj_inv=vbld_inv(j+nres)
835 sig0ij=sigma(itypi,itypj)
836 chi1=chi(itypi,itypj)
837 chi2=chi(itypj,itypi)
844 alf12=0.5D0*(alf1+alf2)
845 C For diagnostics only!!!
858 dxj=dc_norm(1,nres+j)
859 dyj=dc_norm(2,nres+j)
860 dzj=dc_norm(3,nres+j)
861 c write (iout,*) i,j,xj,yj,zj
862 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
864 C Calculate angle-dependent terms of energy and contributions to their
868 sig=sig0ij*dsqrt(sigsq)
869 rij_shift=1.0D0/rij-sig+sig0ij
870 C I hate to put IF's in the loops, but here don't have another choice!!!!
871 if (rij_shift.le.0.0D0) then
876 c---------------------------------------------------------------
877 rij_shift=1.0D0/rij_shift
879 e1=fac*fac*aa(itypi,itypj)
880 e2=fac*bb(itypi,itypj)
881 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
882 eps2der=evdwij*eps3rt
883 eps3der=evdwij*eps2rt
884 evdwij=evdwij*eps2rt*eps3rt
885 if (bb(itypi,itypj).gt.0) then
890 ij=icant(itypi,itypj)
891 aux=eps1*eps2rt**2*eps3rt**2
892 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
893 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
894 c & aux*e2/eps(itypi,itypj)
896 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
897 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
898 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
899 c & restyp(itypi),i,restyp(itypj),j,
900 c & epsi,sigm,chi1,chi2,chip1,chip2,
901 c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
902 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
904 c write (iout,*) "pratial sum", evdw,evdw_t
907 C Calculate gradient components.
908 e1=e1*eps1*eps2rt**2*eps3rt**2
909 fac=-expon*(e1+evdwij)*rij_shift
912 C Calculate the radial part of the gradient
916 C Calculate angular part of the gradient.
925 C-----------------------------------------------------------------------------
926 subroutine egbv(evdw,evdw_t)
928 C This subroutine calculates the interaction energy of nonbonded side chains
929 C assuming the Gay-Berne-Vorobjev potential of interaction.
931 implicit real*8 (a-h,o-z)
933 include 'sizesclu.dat'
934 include "DIMENSIONS.COMPAR"
937 include 'COMMON.LOCAL'
938 include 'COMMON.CHAIN'
939 include 'COMMON.DERIV'
940 include 'COMMON.NAMES'
941 include 'COMMON.INTERACT'
942 include 'COMMON.IOUNITS'
943 include 'COMMON.CALC'
950 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
953 c if (icall.gt.0) lprn=.true.
957 if (itypi.eq.ntyp1) cycle
958 itypi1=iabs(itype(i+1))
962 dxi=dc_norm(1,nres+i)
963 dyi=dc_norm(2,nres+i)
964 dzi=dc_norm(3,nres+i)
965 dsci_inv=vbld_inv(i+nres)
967 C Calculate SC interaction energy.
970 do j=istart(i,iint),iend(i,iint)
973 if (itypj.eq.ntyp1) cycle
974 dscj_inv=vbld_inv(j+nres)
975 sig0ij=sigma(itypi,itypj)
977 chi1=chi(itypi,itypj)
978 chi2=chi(itypj,itypi)
985 alf12=0.5D0*(alf1+alf2)
986 C For diagnostics only!!!
999 dxj=dc_norm(1,nres+j)
1000 dyj=dc_norm(2,nres+j)
1001 dzj=dc_norm(3,nres+j)
1002 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1004 C Calculate angle-dependent terms of energy and contributions to their
1008 sig=sig0ij*dsqrt(sigsq)
1009 rij_shift=1.0D0/rij-sig+r0ij
1010 C I hate to put IF's in the loops, but here don't have another choice!!!!
1011 if (rij_shift.le.0.0D0) then
1016 c---------------------------------------------------------------
1017 rij_shift=1.0D0/rij_shift
1018 fac=rij_shift**expon
1019 e1=fac*fac*aa(itypi,itypj)
1020 e2=fac*bb(itypi,itypj)
1021 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1022 eps2der=evdwij*eps3rt
1023 eps3der=evdwij*eps2rt
1024 fac_augm=rrij**expon
1025 e_augm=augm(itypi,itypj)*fac_augm
1026 evdwij=evdwij*eps2rt*eps3rt
1027 if (bb(itypi,itypj).gt.0.0d0) then
1028 evdw=evdw+evdwij+e_augm
1030 evdw_t=evdw_t+evdwij+e_augm
1032 ij=icant(itypi,itypj)
1033 aux=eps1*eps2rt**2*eps3rt**2
1035 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1036 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1037 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1038 c & restyp(itypi),i,restyp(itypj),j,
1039 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1040 c & chi1,chi2,chip1,chip2,
1041 c & eps1,eps2rt**2,eps3rt**2,
1042 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1046 C Calculate gradient components.
1047 e1=e1*eps1*eps2rt**2*eps3rt**2
1048 fac=-expon*(e1+evdwij)*rij_shift
1050 fac=rij*fac-2*expon*rrij*e_augm
1051 C Calculate the radial part of the gradient
1055 C Calculate angular part of the gradient.
1063 C-----------------------------------------------------------------------------
1064 subroutine sc_angular
1065 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1066 C om12. Called by ebp, egb, and egbv.
1068 include 'COMMON.CALC'
1072 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1073 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1074 om12=dxi*dxj+dyi*dyj+dzi*dzj
1076 C Calculate eps1(om12) and its derivative in om12
1077 faceps1=1.0D0-om12*chiom12
1078 faceps1_inv=1.0D0/faceps1
1079 eps1=dsqrt(faceps1_inv)
1080 C Following variable is eps1*deps1/dom12
1081 eps1_om12=faceps1_inv*chiom12
1082 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1087 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1088 sigsq=1.0D0-facsig*faceps1_inv
1089 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1090 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1091 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1092 C Calculate eps2 and its derivatives in om1, om2, and om12.
1095 chipom12=chip12*om12
1096 facp=1.0D0-om12*chipom12
1098 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1099 C Following variable is the square root of eps2
1100 eps2rt=1.0D0-facp1*facp_inv
1101 C Following three variables are the derivatives of the square root of eps
1102 C in om1, om2, and om12.
1103 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1104 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1105 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1106 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1107 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1108 C Calculate whole angle-dependent part of epsilon and contributions
1109 C to its derivatives
1112 C----------------------------------------------------------------------------
1114 implicit real*8 (a-h,o-z)
1115 include 'DIMENSIONS'
1116 include 'sizesclu.dat'
1117 include 'COMMON.CHAIN'
1118 include 'COMMON.DERIV'
1119 include 'COMMON.CALC'
1120 double precision dcosom1(3),dcosom2(3)
1121 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1122 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1123 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1124 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1126 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1127 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1130 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1133 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1134 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1135 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1136 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1137 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1138 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1141 C Calculate the components of the gradient in DC and X
1145 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1150 c------------------------------------------------------------------------------
1151 subroutine vec_and_deriv
1152 implicit real*8 (a-h,o-z)
1153 include 'DIMENSIONS'
1154 include 'sizesclu.dat'
1155 include 'COMMON.IOUNITS'
1156 include 'COMMON.GEO'
1157 include 'COMMON.VAR'
1158 include 'COMMON.LOCAL'
1159 include 'COMMON.CHAIN'
1160 include 'COMMON.VECTORS'
1161 include 'COMMON.DERIV'
1162 include 'COMMON.INTERACT'
1163 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1164 C Compute the local reference systems. For reference system (i), the
1165 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1166 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1168 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1169 if (i.eq.nres-1) then
1170 C Case of the last full residue
1171 C Compute the Z-axis
1172 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1173 costh=dcos(pi-theta(nres))
1174 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1179 C Compute the derivatives of uz
1181 uzder(2,1,1)=-dc_norm(3,i-1)
1182 uzder(3,1,1)= dc_norm(2,i-1)
1183 uzder(1,2,1)= dc_norm(3,i-1)
1185 uzder(3,2,1)=-dc_norm(1,i-1)
1186 uzder(1,3,1)=-dc_norm(2,i-1)
1187 uzder(2,3,1)= dc_norm(1,i-1)
1190 uzder(2,1,2)= dc_norm(3,i)
1191 uzder(3,1,2)=-dc_norm(2,i)
1192 uzder(1,2,2)=-dc_norm(3,i)
1194 uzder(3,2,2)= dc_norm(1,i)
1195 uzder(1,3,2)= dc_norm(2,i)
1196 uzder(2,3,2)=-dc_norm(1,i)
1199 C Compute the Y-axis
1202 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1205 C Compute the derivatives of uy
1208 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1209 & -dc_norm(k,i)*dc_norm(j,i-1)
1210 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1212 uyder(j,j,1)=uyder(j,j,1)-costh
1213 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1218 uygrad(l,k,j,i)=uyder(l,k,j)
1219 uzgrad(l,k,j,i)=uzder(l,k,j)
1223 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1224 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1225 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1226 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1230 C Compute the Z-axis
1231 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1232 costh=dcos(pi-theta(i+2))
1233 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1238 C Compute the derivatives of uz
1240 uzder(2,1,1)=-dc_norm(3,i+1)
1241 uzder(3,1,1)= dc_norm(2,i+1)
1242 uzder(1,2,1)= dc_norm(3,i+1)
1244 uzder(3,2,1)=-dc_norm(1,i+1)
1245 uzder(1,3,1)=-dc_norm(2,i+1)
1246 uzder(2,3,1)= dc_norm(1,i+1)
1249 uzder(2,1,2)= dc_norm(3,i)
1250 uzder(3,1,2)=-dc_norm(2,i)
1251 uzder(1,2,2)=-dc_norm(3,i)
1253 uzder(3,2,2)= dc_norm(1,i)
1254 uzder(1,3,2)= dc_norm(2,i)
1255 uzder(2,3,2)=-dc_norm(1,i)
1258 C Compute the Y-axis
1261 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1264 C Compute the derivatives of uy
1267 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1268 & -dc_norm(k,i)*dc_norm(j,i+1)
1269 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1271 uyder(j,j,1)=uyder(j,j,1)-costh
1272 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1277 uygrad(l,k,j,i)=uyder(l,k,j)
1278 uzgrad(l,k,j,i)=uzder(l,k,j)
1282 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1283 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1284 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1285 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1291 vbld_inv_temp(1)=vbld_inv(i+1)
1292 if (i.lt.nres-1) then
1293 vbld_inv_temp(2)=vbld_inv(i+2)
1295 vbld_inv_temp(2)=vbld_inv(i)
1300 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1301 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1309 C-----------------------------------------------------------------------------
1310 subroutine vec_and_deriv_test
1311 implicit real*8 (a-h,o-z)
1312 include 'DIMENSIONS'
1313 include 'sizesclu.dat'
1314 include 'COMMON.IOUNITS'
1315 include 'COMMON.GEO'
1316 include 'COMMON.VAR'
1317 include 'COMMON.LOCAL'
1318 include 'COMMON.CHAIN'
1319 include 'COMMON.VECTORS'
1320 dimension uyder(3,3,2),uzder(3,3,2)
1321 C Compute the local reference systems. For reference system (i), the
1322 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1323 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1325 if (i.eq.nres-1) then
1326 C Case of the last full residue
1327 C Compute the Z-axis
1328 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1329 costh=dcos(pi-theta(nres))
1330 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1331 c write (iout,*) 'fac',fac,
1332 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1333 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1337 C Compute the derivatives of uz
1339 uzder(2,1,1)=-dc_norm(3,i-1)
1340 uzder(3,1,1)= dc_norm(2,i-1)
1341 uzder(1,2,1)= dc_norm(3,i-1)
1343 uzder(3,2,1)=-dc_norm(1,i-1)
1344 uzder(1,3,1)=-dc_norm(2,i-1)
1345 uzder(2,3,1)= dc_norm(1,i-1)
1348 uzder(2,1,2)= dc_norm(3,i)
1349 uzder(3,1,2)=-dc_norm(2,i)
1350 uzder(1,2,2)=-dc_norm(3,i)
1352 uzder(3,2,2)= dc_norm(1,i)
1353 uzder(1,3,2)= dc_norm(2,i)
1354 uzder(2,3,2)=-dc_norm(1,i)
1356 C Compute the Y-axis
1358 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1361 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1362 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1363 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1365 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1368 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1369 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1372 c write (iout,*) 'facy',facy,
1373 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1374 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1376 uy(k,i)=facy*uy(k,i)
1378 C Compute the derivatives of uy
1381 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1382 & -dc_norm(k,i)*dc_norm(j,i-1)
1383 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1385 c uyder(j,j,1)=uyder(j,j,1)-costh
1386 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1387 uyder(j,j,1)=uyder(j,j,1)
1388 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1389 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1395 uygrad(l,k,j,i)=uyder(l,k,j)
1396 uzgrad(l,k,j,i)=uzder(l,k,j)
1400 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1401 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1402 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1403 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1406 C Compute the Z-axis
1407 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1408 costh=dcos(pi-theta(i+2))
1409 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1410 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1414 C Compute the derivatives of uz
1416 uzder(2,1,1)=-dc_norm(3,i+1)
1417 uzder(3,1,1)= dc_norm(2,i+1)
1418 uzder(1,2,1)= dc_norm(3,i+1)
1420 uzder(3,2,1)=-dc_norm(1,i+1)
1421 uzder(1,3,1)=-dc_norm(2,i+1)
1422 uzder(2,3,1)= dc_norm(1,i+1)
1425 uzder(2,1,2)= dc_norm(3,i)
1426 uzder(3,1,2)=-dc_norm(2,i)
1427 uzder(1,2,2)=-dc_norm(3,i)
1429 uzder(3,2,2)= dc_norm(1,i)
1430 uzder(1,3,2)= dc_norm(2,i)
1431 uzder(2,3,2)=-dc_norm(1,i)
1433 C Compute the Y-axis
1435 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1436 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1437 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1439 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1442 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1443 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1446 c write (iout,*) 'facy',facy,
1447 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1448 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1450 uy(k,i)=facy*uy(k,i)
1452 C Compute the derivatives of uy
1455 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1456 & -dc_norm(k,i)*dc_norm(j,i+1)
1457 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1459 c uyder(j,j,1)=uyder(j,j,1)-costh
1460 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1461 uyder(j,j,1)=uyder(j,j,1)
1462 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1463 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1469 uygrad(l,k,j,i)=uyder(l,k,j)
1470 uzgrad(l,k,j,i)=uzder(l,k,j)
1474 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1475 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1476 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1477 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1484 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1485 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1492 C-----------------------------------------------------------------------------
1493 subroutine check_vecgrad
1494 implicit real*8 (a-h,o-z)
1495 include 'DIMENSIONS'
1496 include 'sizesclu.dat'
1497 include 'COMMON.IOUNITS'
1498 include 'COMMON.GEO'
1499 include 'COMMON.VAR'
1500 include 'COMMON.LOCAL'
1501 include 'COMMON.CHAIN'
1502 include 'COMMON.VECTORS'
1503 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1504 dimension uyt(3,maxres),uzt(3,maxres)
1505 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1506 double precision delta /1.0d-7/
1509 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1510 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1511 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1512 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1513 cd & (dc_norm(if90,i),if90=1,3)
1514 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1515 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1516 cd write(iout,'(a)')
1522 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1523 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1536 cd write (iout,*) 'i=',i
1538 erij(k)=dc_norm(k,i)
1542 dc_norm(k,i)=erij(k)
1544 dc_norm(j,i)=dc_norm(j,i)+delta
1545 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1547 c dc_norm(k,i)=dc_norm(k,i)/fac
1549 c write (iout,*) (dc_norm(k,i),k=1,3)
1550 c write (iout,*) (erij(k),k=1,3)
1553 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1554 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1555 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1556 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1558 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1559 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1560 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1563 dc_norm(k,i)=erij(k)
1566 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1567 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1568 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1569 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1570 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1571 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1572 cd write (iout,'(a)')
1577 C--------------------------------------------------------------------------
1578 subroutine set_matrices
1579 implicit real*8 (a-h,o-z)
1580 include 'DIMENSIONS'
1581 include 'sizesclu.dat'
1582 include 'COMMON.IOUNITS'
1583 include 'COMMON.GEO'
1584 include 'COMMON.VAR'
1585 include 'COMMON.LOCAL'
1586 include 'COMMON.CHAIN'
1587 include 'COMMON.DERIV'
1588 include 'COMMON.INTERACT'
1589 include 'COMMON.CONTACTS'
1590 include 'COMMON.TORSION'
1591 include 'COMMON.VECTORS'
1592 include 'COMMON.FFIELD'
1593 double precision auxvec(2),auxmat(2,2)
1595 C Compute the virtual-bond-torsional-angle dependent quantities needed
1596 C to calculate the el-loc multibody terms of various order.
1599 if (i .lt. nres+1) then
1636 if (i .gt. 3 .and. i .lt. nres+1) then
1637 obrot_der(1,i-2)=-sin1
1638 obrot_der(2,i-2)= cos1
1639 Ugder(1,1,i-2)= sin1
1640 Ugder(1,2,i-2)=-cos1
1641 Ugder(2,1,i-2)=-cos1
1642 Ugder(2,2,i-2)=-sin1
1645 obrot2_der(1,i-2)=-dwasin2
1646 obrot2_der(2,i-2)= dwacos2
1647 Ug2der(1,1,i-2)= dwasin2
1648 Ug2der(1,2,i-2)=-dwacos2
1649 Ug2der(2,1,i-2)=-dwacos2
1650 Ug2der(2,2,i-2)=-dwasin2
1652 obrot_der(1,i-2)=0.0d0
1653 obrot_der(2,i-2)=0.0d0
1654 Ugder(1,1,i-2)=0.0d0
1655 Ugder(1,2,i-2)=0.0d0
1656 Ugder(2,1,i-2)=0.0d0
1657 Ugder(2,2,i-2)=0.0d0
1658 obrot2_der(1,i-2)=0.0d0
1659 obrot2_der(2,i-2)=0.0d0
1660 Ug2der(1,1,i-2)=0.0d0
1661 Ug2der(1,2,i-2)=0.0d0
1662 Ug2der(2,1,i-2)=0.0d0
1663 Ug2der(2,2,i-2)=0.0d0
1665 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1666 if (itype(i-2).le.ntyp) then
1667 iti = itortyp(itype(i-2))
1674 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1675 if (itype(i-1).le.ntyp) then
1676 iti1 = itortyp(itype(i-1))
1683 cd write (iout,*) '*******i',i,' iti1',iti
1684 cd write (iout,*) 'b1',b1(:,iti)
1685 cd write (iout,*) 'b2',b2(:,iti)
1686 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1687 c print *,"itilde1 i iti iti1",i,iti,iti1
1688 if (i .gt. iatel_s+2) then
1689 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1690 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1691 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1692 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1693 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1694 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1695 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1705 DtUg2(l,k,i-2)=0.0d0
1709 c print *,"itilde2 i iti iti1",i,iti,iti1
1710 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1711 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1712 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1713 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1714 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1715 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1716 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1717 c print *,"itilde3 i iti iti1",i,iti,iti1
1719 muder(k,i-2)=Ub2der(k,i-2)
1721 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1722 if (itype(i-1).le.ntyp) then
1723 iti1 = itortyp(itype(i-1))
1731 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1733 C Vectors and matrices dependent on a single virtual-bond dihedral.
1734 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1735 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1736 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1737 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1738 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1739 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1740 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1741 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1742 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1743 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1744 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1746 C Matrices dependent on two consecutive virtual-bond dihedrals.
1747 C The order of matrices is from left to right.
1749 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1750 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1751 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1752 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1753 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1754 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1755 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1756 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1759 cd iti = itortyp(itype(i))
1762 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1763 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1768 C--------------------------------------------------------------------------
1769 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1771 C This subroutine calculates the average interaction energy and its gradient
1772 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1773 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1774 C The potential depends both on the distance of peptide-group centers and on
1775 C the orientation of the CA-CA virtual bonds.
1777 implicit real*8 (a-h,o-z)
1778 include 'DIMENSIONS'
1779 include 'sizesclu.dat'
1780 include 'COMMON.CONTROL'
1781 include 'COMMON.IOUNITS'
1782 include 'COMMON.GEO'
1783 include 'COMMON.VAR'
1784 include 'COMMON.LOCAL'
1785 include 'COMMON.CHAIN'
1786 include 'COMMON.DERIV'
1787 include 'COMMON.INTERACT'
1788 include 'COMMON.CONTACTS'
1789 include 'COMMON.TORSION'
1790 include 'COMMON.VECTORS'
1791 include 'COMMON.FFIELD'
1792 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1793 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1794 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1795 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1796 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1797 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1798 double precision scal_el /0.5d0/
1800 C 13-go grudnia roku pamietnego...
1801 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1802 & 0.0d0,1.0d0,0.0d0,
1803 & 0.0d0,0.0d0,1.0d0/
1804 cd write(iout,*) 'In EELEC'
1806 cd write(iout,*) 'Type',i
1807 cd write(iout,*) 'B1',B1(:,i)
1808 cd write(iout,*) 'B2',B2(:,i)
1809 cd write(iout,*) 'CC',CC(:,:,i)
1810 cd write(iout,*) 'DD',DD(:,:,i)
1811 cd write(iout,*) 'EE',EE(:,:,i)
1813 cd call check_vecgrad
1815 if (icheckgrad.eq.1) then
1817 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1819 dc_norm(k,i)=dc(k,i)*fac
1821 c write (iout,*) 'i',i,' fac',fac
1824 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1825 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1826 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1827 cd if (wel_loc.gt.0.0d0) then
1828 if (icheckgrad.eq.1) then
1829 call vec_and_deriv_test
1836 cd write (iout,*) 'i=',i
1838 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1841 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1842 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1855 cd print '(a)','Enter EELEC'
1856 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1858 gel_loc_loc(i)=0.0d0
1861 do i=iatel_s,iatel_e
1862 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1863 if (itel(i).eq.0) goto 1215
1867 dx_normi=dc_norm(1,i)
1868 dy_normi=dc_norm(2,i)
1869 dz_normi=dc_norm(3,i)
1870 xmedi=c(1,i)+0.5d0*dxi
1871 ymedi=c(2,i)+0.5d0*dyi
1872 zmedi=c(3,i)+0.5d0*dzi
1874 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1875 do j=ielstart(i),ielend(i)
1876 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1877 if (itel(j).eq.0) goto 1216
1881 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1882 aaa=app(iteli,itelj)
1883 bbb=bpp(iteli,itelj)
1884 C Diagnostics only!!!
1890 ael6i=ael6(iteli,itelj)
1891 ael3i=ael3(iteli,itelj)
1895 dx_normj=dc_norm(1,j)
1896 dy_normj=dc_norm(2,j)
1897 dz_normj=dc_norm(3,j)
1898 xj=c(1,j)+0.5D0*dxj-xmedi
1899 yj=c(2,j)+0.5D0*dyj-ymedi
1900 zj=c(3,j)+0.5D0*dzj-zmedi
1901 rij=xj*xj+yj*yj+zj*zj
1907 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1908 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1909 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1910 fac=cosa-3.0D0*cosb*cosg
1912 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1913 if (j.eq.i+2) ev1=scal_el*ev1
1918 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1921 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1922 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1923 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1926 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1927 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1928 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1929 cd & xmedi,ymedi,zmedi,xj,yj,zj
1931 C Calculate contributions to the Cartesian gradient.
1934 facvdw=-6*rrmij*(ev1+evdwij)
1935 facel=-3*rrmij*(el1+eesij)
1942 * Radial derivatives. First process both termini of the fragment (i,j)
1949 gelc(k,i)=gelc(k,i)+ghalf
1950 gelc(k,j)=gelc(k,j)+ghalf
1953 * Loop over residues i+1 thru j-1.
1957 gelc(l,k)=gelc(l,k)+ggg(l)
1965 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1966 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1969 * Loop over residues i+1 thru j-1.
1973 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1980 fac=-3*rrmij*(facvdw+facvdw+facel)
1986 * Radial derivatives. First process both termini of the fragment (i,j)
1993 gelc(k,i)=gelc(k,i)+ghalf
1994 gelc(k,j)=gelc(k,j)+ghalf
1997 * Loop over residues i+1 thru j-1.
2001 gelc(l,k)=gelc(l,k)+ggg(l)
2008 ecosa=2.0D0*fac3*fac1+fac4
2011 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2012 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2014 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2015 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2017 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2018 cd & (dcosg(k),k=1,3)
2020 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2024 gelc(k,i)=gelc(k,i)+ghalf
2025 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2026 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2027 gelc(k,j)=gelc(k,j)+ghalf
2028 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2029 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2033 gelc(l,k)=gelc(l,k)+ggg(l)
2038 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2039 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2040 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2042 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2043 C energy of a peptide unit is assumed in the form of a second-order
2044 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2045 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2046 C are computed for EVERY pair of non-contiguous peptide groups.
2048 if (j.lt.nres-1) then
2059 muij(kkk)=mu(k,i)*mu(l,j)
2062 cd write (iout,*) 'EELEC: i',i,' j',j
2063 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2064 cd write(iout,*) 'muij',muij
2065 ury=scalar(uy(1,i),erij)
2066 urz=scalar(uz(1,i),erij)
2067 vry=scalar(uy(1,j),erij)
2068 vrz=scalar(uz(1,j),erij)
2069 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2070 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2071 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2072 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2073 C For diagnostics only
2078 fac=dsqrt(-ael6i)*r3ij
2079 cd write (2,*) 'fac=',fac
2080 C For diagnostics only
2086 cd write (iout,'(4i5,4f10.5)')
2087 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2088 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2089 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2090 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2091 cd write (iout,'(4f10.5)')
2092 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2093 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2094 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2095 cd write (iout,'(2i3,9f10.5/)') i,j,
2096 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2098 C Derivatives of the elements of A in virtual-bond vectors
2099 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2106 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2107 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2108 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2109 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2110 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2111 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2112 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2113 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2114 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2115 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2116 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2117 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2127 C Compute radial contributions to the gradient
2149 C Add the contributions coming from er
2152 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2153 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2154 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2155 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2158 C Derivatives in DC(i)
2159 ghalf1=0.5d0*agg(k,1)
2160 ghalf2=0.5d0*agg(k,2)
2161 ghalf3=0.5d0*agg(k,3)
2162 ghalf4=0.5d0*agg(k,4)
2163 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2164 & -3.0d0*uryg(k,2)*vry)+ghalf1
2165 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2166 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2167 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2168 & -3.0d0*urzg(k,2)*vry)+ghalf3
2169 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2170 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2171 C Derivatives in DC(i+1)
2172 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2173 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2174 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2175 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2176 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2177 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2178 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2179 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2180 C Derivatives in DC(j)
2181 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2182 & -3.0d0*vryg(k,2)*ury)+ghalf1
2183 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2184 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2185 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2186 & -3.0d0*vryg(k,2)*urz)+ghalf3
2187 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2188 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2189 C Derivatives in DC(j+1) or DC(nres-1)
2190 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2191 & -3.0d0*vryg(k,3)*ury)
2192 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2193 & -3.0d0*vrzg(k,3)*ury)
2194 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2195 & -3.0d0*vryg(k,3)*urz)
2196 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2197 & -3.0d0*vrzg(k,3)*urz)
2202 C Derivatives in DC(i+1)
2203 cd aggi1(k,1)=agg(k,1)
2204 cd aggi1(k,2)=agg(k,2)
2205 cd aggi1(k,3)=agg(k,3)
2206 cd aggi1(k,4)=agg(k,4)
2207 C Derivatives in DC(j)
2212 C Derivatives in DC(j+1)
2217 if (j.eq.nres-1 .and. i.lt.j-2) then
2219 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2220 cd aggj1(k,l)=agg(k,l)
2226 C Check the loc-el terms by numerical integration
2236 aggi(k,l)=-aggi(k,l)
2237 aggi1(k,l)=-aggi1(k,l)
2238 aggj(k,l)=-aggj(k,l)
2239 aggj1(k,l)=-aggj1(k,l)
2242 if (j.lt.nres-1) then
2248 aggi(k,l)=-aggi(k,l)
2249 aggi1(k,l)=-aggi1(k,l)
2250 aggj(k,l)=-aggj(k,l)
2251 aggj1(k,l)=-aggj1(k,l)
2262 aggi(k,l)=-aggi(k,l)
2263 aggi1(k,l)=-aggi1(k,l)
2264 aggj(k,l)=-aggj(k,l)
2265 aggj1(k,l)=-aggj1(k,l)
2271 IF (wel_loc.gt.0.0d0) THEN
2272 C Contribution to the local-electrostatic energy coming from the i-j pair
2273 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2275 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2276 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2277 eel_loc=eel_loc+eel_loc_ij
2278 C Partial derivatives in virtual-bond dihedral angles gamma
2281 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2282 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2283 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2284 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2285 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2286 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2287 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2288 cd write(iout,*) 'agg ',agg
2289 cd write(iout,*) 'aggi ',aggi
2290 cd write(iout,*) 'aggi1',aggi1
2291 cd write(iout,*) 'aggj ',aggj
2292 cd write(iout,*) 'aggj1',aggj1
2294 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2296 ggg(l)=agg(l,1)*muij(1)+
2297 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2301 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2304 C Remaining derivatives of eello
2306 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2307 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2308 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2309 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2310 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2311 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2312 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2313 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2317 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2318 C Contributions from turns
2323 call eturn34(i,j,eello_turn3,eello_turn4)
2325 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2326 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2328 C Calculate the contact function. The ith column of the array JCONT will
2329 C contain the numbers of atoms that make contacts with the atom I (of numbers
2330 C greater than I). The arrays FACONT and GACONT will contain the values of
2331 C the contact function and its derivative.
2332 c r0ij=1.02D0*rpp(iteli,itelj)
2333 c r0ij=1.11D0*rpp(iteli,itelj)
2334 r0ij=2.20D0*rpp(iteli,itelj)
2335 c r0ij=1.55D0*rpp(iteli,itelj)
2336 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2337 if (fcont.gt.0.0D0) then
2338 num_conti=num_conti+1
2339 if (num_conti.gt.maxconts) then
2340 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2341 & ' will skip next contacts for this conf.'
2343 jcont_hb(num_conti,i)=j
2344 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2345 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2346 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2348 d_cont(num_conti,i)=rij
2349 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2350 C --- Electrostatic-interaction matrix ---
2351 a_chuj(1,1,num_conti,i)=a22
2352 a_chuj(1,2,num_conti,i)=a23
2353 a_chuj(2,1,num_conti,i)=a32
2354 a_chuj(2,2,num_conti,i)=a33
2355 C --- Gradient of rij
2357 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2360 c a_chuj(1,1,num_conti,i)=-0.61d0
2361 c a_chuj(1,2,num_conti,i)= 0.4d0
2362 c a_chuj(2,1,num_conti,i)= 0.65d0
2363 c a_chuj(2,2,num_conti,i)= 0.50d0
2364 c else if (i.eq.2) then
2365 c a_chuj(1,1,num_conti,i)= 0.0d0
2366 c a_chuj(1,2,num_conti,i)= 0.0d0
2367 c a_chuj(2,1,num_conti,i)= 0.0d0
2368 c a_chuj(2,2,num_conti,i)= 0.0d0
2370 C --- and its gradients
2371 cd write (iout,*) 'i',i,' j',j
2373 cd write (iout,*) 'iii 1 kkk',kkk
2374 cd write (iout,*) agg(kkk,:)
2377 cd write (iout,*) 'iii 2 kkk',kkk
2378 cd write (iout,*) aggi(kkk,:)
2381 cd write (iout,*) 'iii 3 kkk',kkk
2382 cd write (iout,*) aggi1(kkk,:)
2385 cd write (iout,*) 'iii 4 kkk',kkk
2386 cd write (iout,*) aggj(kkk,:)
2389 cd write (iout,*) 'iii 5 kkk',kkk
2390 cd write (iout,*) aggj1(kkk,:)
2397 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2398 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2399 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2400 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2401 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2403 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2409 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2410 C Calculate contact energies
2412 wij=cosa-3.0D0*cosb*cosg
2415 c fac3=dsqrt(-ael6i)/r0ij**3
2416 fac3=dsqrt(-ael6i)*r3ij
2417 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2418 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2420 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2421 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2422 C Diagnostics. Comment out or remove after debugging!
2423 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2424 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2425 c ees0m(num_conti,i)=0.0D0
2427 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2428 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2429 facont_hb(num_conti,i)=fcont
2431 C Angular derivatives of the contact function
2432 ees0pij1=fac3/ees0pij
2433 ees0mij1=fac3/ees0mij
2434 fac3p=-3.0D0*fac3*rrmij
2435 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2436 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2438 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2439 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2440 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2441 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2442 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2443 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2444 ecosap=ecosa1+ecosa2
2445 ecosbp=ecosb1+ecosb2
2446 ecosgp=ecosg1+ecosg2
2447 ecosam=ecosa1-ecosa2
2448 ecosbm=ecosb1-ecosb2
2449 ecosgm=ecosg1-ecosg2
2458 fprimcont=fprimcont/rij
2459 cd facont_hb(num_conti,i)=1.0D0
2460 C Following line is for diagnostics.
2463 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2464 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2467 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2468 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2470 gggp(1)=gggp(1)+ees0pijp*xj
2471 gggp(2)=gggp(2)+ees0pijp*yj
2472 gggp(3)=gggp(3)+ees0pijp*zj
2473 gggm(1)=gggm(1)+ees0mijp*xj
2474 gggm(2)=gggm(2)+ees0mijp*yj
2475 gggm(3)=gggm(3)+ees0mijp*zj
2476 C Derivatives due to the contact function
2477 gacont_hbr(1,num_conti,i)=fprimcont*xj
2478 gacont_hbr(2,num_conti,i)=fprimcont*yj
2479 gacont_hbr(3,num_conti,i)=fprimcont*zj
2481 ghalfp=0.5D0*gggp(k)
2482 ghalfm=0.5D0*gggm(k)
2483 gacontp_hb1(k,num_conti,i)=ghalfp
2484 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2485 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2486 gacontp_hb2(k,num_conti,i)=ghalfp
2487 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2488 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2489 gacontp_hb3(k,num_conti,i)=gggp(k)
2490 gacontm_hb1(k,num_conti,i)=ghalfm
2491 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2492 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2493 gacontm_hb2(k,num_conti,i)=ghalfm
2494 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2495 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2496 gacontm_hb3(k,num_conti,i)=gggm(k)
2499 C Diagnostics. Comment out or remove after debugging!
2501 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2502 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2503 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2504 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2505 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2506 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2509 endif ! num_conti.le.maxconts
2514 num_cont_hb(i)=num_conti
2518 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2519 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2521 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2522 ccc eel_loc=eel_loc+eello_turn3
2525 C-----------------------------------------------------------------------------
2526 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2527 C Third- and fourth-order contributions from turns
2528 implicit real*8 (a-h,o-z)
2529 include 'DIMENSIONS'
2530 include 'sizesclu.dat'
2531 include 'COMMON.IOUNITS'
2532 include 'COMMON.GEO'
2533 include 'COMMON.VAR'
2534 include 'COMMON.LOCAL'
2535 include 'COMMON.CHAIN'
2536 include 'COMMON.DERIV'
2537 include 'COMMON.INTERACT'
2538 include 'COMMON.CONTACTS'
2539 include 'COMMON.TORSION'
2540 include 'COMMON.VECTORS'
2541 include 'COMMON.FFIELD'
2543 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2544 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2545 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2546 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2547 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2548 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2550 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2552 C Third-order contributions
2559 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2560 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2561 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2562 call transpose2(auxmat(1,1),auxmat1(1,1))
2563 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2564 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2565 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2566 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2567 cd & ' eello_turn3_num',4*eello_turn3_num
2569 C Derivatives in gamma(i)
2570 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2571 call transpose2(auxmat2(1,1),pizda(1,1))
2572 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2573 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2574 C Derivatives in gamma(i+1)
2575 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2576 call transpose2(auxmat2(1,1),pizda(1,1))
2577 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2578 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2579 & +0.5d0*(pizda(1,1)+pizda(2,2))
2580 C Cartesian derivatives
2582 a_temp(1,1)=aggi(l,1)
2583 a_temp(1,2)=aggi(l,2)
2584 a_temp(2,1)=aggi(l,3)
2585 a_temp(2,2)=aggi(l,4)
2586 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2587 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2588 & +0.5d0*(pizda(1,1)+pizda(2,2))
2589 a_temp(1,1)=aggi1(l,1)
2590 a_temp(1,2)=aggi1(l,2)
2591 a_temp(2,1)=aggi1(l,3)
2592 a_temp(2,2)=aggi1(l,4)
2593 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2594 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2595 & +0.5d0*(pizda(1,1)+pizda(2,2))
2596 a_temp(1,1)=aggj(l,1)
2597 a_temp(1,2)=aggj(l,2)
2598 a_temp(2,1)=aggj(l,3)
2599 a_temp(2,2)=aggj(l,4)
2600 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2601 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2602 & +0.5d0*(pizda(1,1)+pizda(2,2))
2603 a_temp(1,1)=aggj1(l,1)
2604 a_temp(1,2)=aggj1(l,2)
2605 a_temp(2,1)=aggj1(l,3)
2606 a_temp(2,2)=aggj1(l,4)
2607 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2608 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2609 & +0.5d0*(pizda(1,1)+pizda(2,2))
2612 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2613 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2615 C Fourth-order contributions
2623 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2624 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2625 iti1=itortyp(itype(i+1))
2626 iti2=itortyp(itype(i+2))
2627 iti3=itortyp(itype(i+3))
2628 call transpose2(EUg(1,1,i+1),e1t(1,1))
2629 call transpose2(Eug(1,1,i+2),e2t(1,1))
2630 call transpose2(Eug(1,1,i+3),e3t(1,1))
2631 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2632 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2633 s1=scalar2(b1(1,iti2),auxvec(1))
2634 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2635 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2636 s2=scalar2(b1(1,iti1),auxvec(1))
2637 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2638 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2639 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2640 eello_turn4=eello_turn4-(s1+s2+s3)
2641 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2642 cd & ' eello_turn4_num',8*eello_turn4_num
2643 C Derivatives in gamma(i)
2645 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2646 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2647 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2648 s1=scalar2(b1(1,iti2),auxvec(1))
2649 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2650 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2651 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2652 C Derivatives in gamma(i+1)
2653 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2654 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2655 s2=scalar2(b1(1,iti1),auxvec(1))
2656 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2657 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2658 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2659 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2660 C Derivatives in gamma(i+2)
2661 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2662 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2663 s1=scalar2(b1(1,iti2),auxvec(1))
2664 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2665 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2666 s2=scalar2(b1(1,iti1),auxvec(1))
2667 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2668 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2669 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2670 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2671 C Cartesian derivatives
2672 C Derivatives of this turn contributions in DC(i+2)
2673 if (j.lt.nres-1) then
2675 a_temp(1,1)=agg(l,1)
2676 a_temp(1,2)=agg(l,2)
2677 a_temp(2,1)=agg(l,3)
2678 a_temp(2,2)=agg(l,4)
2679 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2680 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2681 s1=scalar2(b1(1,iti2),auxvec(1))
2682 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2683 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2684 s2=scalar2(b1(1,iti1),auxvec(1))
2685 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2686 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2687 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2689 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2692 C Remaining derivatives of this turn contribution
2694 a_temp(1,1)=aggi(l,1)
2695 a_temp(1,2)=aggi(l,2)
2696 a_temp(2,1)=aggi(l,3)
2697 a_temp(2,2)=aggi(l,4)
2698 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2699 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2700 s1=scalar2(b1(1,iti2),auxvec(1))
2701 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2702 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2703 s2=scalar2(b1(1,iti1),auxvec(1))
2704 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2705 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2706 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2707 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2708 a_temp(1,1)=aggi1(l,1)
2709 a_temp(1,2)=aggi1(l,2)
2710 a_temp(2,1)=aggi1(l,3)
2711 a_temp(2,2)=aggi1(l,4)
2712 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2713 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2714 s1=scalar2(b1(1,iti2),auxvec(1))
2715 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2716 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2717 s2=scalar2(b1(1,iti1),auxvec(1))
2718 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2719 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2720 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2721 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2722 a_temp(1,1)=aggj(l,1)
2723 a_temp(1,2)=aggj(l,2)
2724 a_temp(2,1)=aggj(l,3)
2725 a_temp(2,2)=aggj(l,4)
2726 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2727 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2728 s1=scalar2(b1(1,iti2),auxvec(1))
2729 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2730 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2731 s2=scalar2(b1(1,iti1),auxvec(1))
2732 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2733 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2734 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2735 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2736 a_temp(1,1)=aggj1(l,1)
2737 a_temp(1,2)=aggj1(l,2)
2738 a_temp(2,1)=aggj1(l,3)
2739 a_temp(2,2)=aggj1(l,4)
2740 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2741 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2742 s1=scalar2(b1(1,iti2),auxvec(1))
2743 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2744 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2745 s2=scalar2(b1(1,iti1),auxvec(1))
2746 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2747 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2748 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2749 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2755 C-----------------------------------------------------------------------------
2756 subroutine vecpr(u,v,w)
2757 implicit real*8(a-h,o-z)
2758 dimension u(3),v(3),w(3)
2759 w(1)=u(2)*v(3)-u(3)*v(2)
2760 w(2)=-u(1)*v(3)+u(3)*v(1)
2761 w(3)=u(1)*v(2)-u(2)*v(1)
2764 C-----------------------------------------------------------------------------
2765 subroutine unormderiv(u,ugrad,unorm,ungrad)
2766 C This subroutine computes the derivatives of a normalized vector u, given
2767 C the derivatives computed without normalization conditions, ugrad. Returns
2770 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2771 double precision vec(3)
2772 double precision scalar
2774 c write (2,*) 'ugrad',ugrad
2777 vec(i)=scalar(ugrad(1,i),u(1))
2779 c write (2,*) 'vec',vec
2782 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2785 c write (2,*) 'ungrad',ungrad
2788 C-----------------------------------------------------------------------------
2789 subroutine escp(evdw2,evdw2_14)
2791 C This subroutine calculates the excluded-volume interaction energy between
2792 C peptide-group centers and side chains and its gradient in virtual-bond and
2793 C side-chain vectors.
2795 implicit real*8 (a-h,o-z)
2796 include 'DIMENSIONS'
2797 include 'sizesclu.dat'
2798 include 'COMMON.GEO'
2799 include 'COMMON.VAR'
2800 include 'COMMON.LOCAL'
2801 include 'COMMON.CHAIN'
2802 include 'COMMON.DERIV'
2803 include 'COMMON.INTERACT'
2804 include 'COMMON.FFIELD'
2805 include 'COMMON.IOUNITS'
2809 cd print '(a)','Enter ESCP'
2810 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2811 c & ' scal14',scal14
2812 do i=iatscp_s,iatscp_e
2813 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2815 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2816 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2817 if (iteli.eq.0) goto 1225
2818 xi=0.5D0*(c(1,i)+c(1,i+1))
2819 yi=0.5D0*(c(2,i)+c(2,i+1))
2820 zi=0.5D0*(c(3,i)+c(3,i+1))
2822 do iint=1,nscp_gr(i)
2824 do j=iscpstart(i,iint),iscpend(i,iint)
2825 itypj=iabs(itype(j))
2826 if (itypj.eq.ntyp1) cycle
2827 C Uncomment following three lines for SC-p interactions
2831 C Uncomment following three lines for Ca-p interactions
2835 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2837 e1=fac*fac*aad(itypj,iteli)
2838 e2=fac*bad(itypj,iteli)
2839 if (iabs(j-i) .le. 2) then
2842 evdw2_14=evdw2_14+e1+e2
2845 c write (iout,*) i,j,evdwij
2849 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2851 fac=-(evdwij+e1)*rrij
2856 cd write (iout,*) 'j<i'
2857 C Uncomment following three lines for SC-p interactions
2859 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2862 cd write (iout,*) 'j>i'
2865 C Uncomment following line for SC-p interactions
2866 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2870 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2874 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2875 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2878 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2888 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2889 gradx_scp(j,i)=expon*gradx_scp(j,i)
2892 C******************************************************************************
2896 C To save time the factor EXPON has been extracted from ALL components
2897 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2900 C******************************************************************************
2903 C--------------------------------------------------------------------------
2904 subroutine edis(ehpb)
2906 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2908 implicit real*8 (a-h,o-z)
2909 include 'DIMENSIONS'
2910 include 'sizesclu.dat'
2911 include 'COMMON.SBRIDGE'
2912 include 'COMMON.CHAIN'
2913 include 'COMMON.DERIV'
2914 include 'COMMON.VAR'
2915 include 'COMMON.INTERACT'
2916 include 'COMMON.CONTROL'
2919 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2920 cd print *,'link_start=',link_start,' link_end=',link_end
2921 if (link_end.eq.0) return
2922 do i=link_start,link_end
2923 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2924 C CA-CA distance used in regularization of structure.
2927 C iii and jjj point to the residues for which the distance is assigned.
2928 if (ii.gt.nres) then
2935 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2936 C distance and angle dependent SS bond potential.
2937 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2938 C & iabs(itype(jjj)).eq.1) then
2939 C call ssbond_ene(iii,jjj,eij)
2942 if (.not.dyn_ss .and. i.le.nss) then
2943 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2944 & iabs(itype(jjj)).eq.1) then
2945 call ssbond_ene(iii,jjj,eij)
2948 else if (ii.gt.nres .and. jj.gt.nres) then
2949 c Restraints from contact prediction
2951 if (constr_dist.eq.11) then
2952 C ehpb=ehpb+fordepth(i)**4.0d0
2953 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2954 ehpb=ehpb+fordepth(i)**4.0d0
2955 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2956 fac=fordepth(i)**4.0d0
2957 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2958 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
2959 C & ehpb,fordepth(i),dd
2961 C write(iout,*) ehpb,"atu?"
2963 C fac=fordepth(i)**4.0d0
2964 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2965 else !constr_dist.eq.11
2966 if (dhpb1(i).gt.0.0d0) then
2967 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2968 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2969 c write (iout,*) "beta nmr",
2970 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2971 else !dhpb(i).gt.0.00
2973 C Calculate the distance between the two points and its difference from the
2977 C Get the force constant corresponding to this distance.
2979 C Calculate the contribution to energy.
2980 ehpb=ehpb+waga*rdis*rdis
2982 C Evaluate gradient.
2987 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2988 cd & ' waga=',waga,' fac=',fac
2990 ggg(j)=fac*(c(j,jj)-c(j,ii))
2992 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2993 C If this is a SC-SC distance, we need to calculate the contributions to the
2994 C Cartesian gradient in the SC vectors (ghpbx).
2997 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2998 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3002 C write(iout,*) "before"
3004 C write(iout,*) "after",dd
3005 if (constr_dist.eq.11) then
3006 ehpb=ehpb+fordepth(i)**4.0d0
3007 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3008 fac=fordepth(i)**4.0d0
3009 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3010 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3011 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3012 C print *,ehpb,"tu?"
3013 C write(iout,*) ehpb,"btu?",
3014 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3015 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3016 C & ehpb,fordepth(i),dd
3018 if (dhpb1(i).gt.0.0d0) then
3019 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3020 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3021 c write (iout,*) "alph nmr",
3022 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3025 C Get the force constant corresponding to this distance.
3027 C Calculate the contribution to energy.
3028 ehpb=ehpb+waga*rdis*rdis
3029 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3031 C Evaluate gradient.
3037 ggg(j)=fac*(c(j,jj)-c(j,ii))
3039 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3040 C If this is a SC-SC distance, we need to calculate the contributions to the
3041 C Cartesian gradient in the SC vectors (ghpbx).
3044 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3045 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3050 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3055 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3058 C--------------------------------------------------------------------------
3059 subroutine ssbond_ene(i,j,eij)
3061 C Calculate the distance and angle dependent SS-bond potential energy
3062 C using a free-energy function derived based on RHF/6-31G** ab initio
3063 C calculations of diethyl disulfide.
3065 C A. Liwo and U. Kozlowska, 11/24/03
3067 implicit real*8 (a-h,o-z)
3068 include 'DIMENSIONS'
3069 include 'sizesclu.dat'
3070 include 'COMMON.SBRIDGE'
3071 include 'COMMON.CHAIN'
3072 include 'COMMON.DERIV'
3073 include 'COMMON.LOCAL'
3074 include 'COMMON.INTERACT'
3075 include 'COMMON.VAR'
3076 include 'COMMON.IOUNITS'
3077 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3078 itypi=iabs(itype(i))
3082 dxi=dc_norm(1,nres+i)
3083 dyi=dc_norm(2,nres+i)
3084 dzi=dc_norm(3,nres+i)
3085 dsci_inv=dsc_inv(itypi)
3086 itypj=iabs(itype(j))
3087 dscj_inv=dsc_inv(itypj)
3091 dxj=dc_norm(1,nres+j)
3092 dyj=dc_norm(2,nres+j)
3093 dzj=dc_norm(3,nres+j)
3094 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3099 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3100 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3101 om12=dxi*dxj+dyi*dyj+dzi*dzj
3103 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3104 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3110 deltat12=om2-om1+2.0d0
3112 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3113 & +akct*deltad*deltat12
3114 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3115 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3116 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3117 c & " deltat12",deltat12," eij",eij
3118 ed=2*akcm*deltad+akct*deltat12
3120 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3121 eom1=-2*akth*deltat1-pom1-om2*pom2
3122 eom2= 2*akth*deltat2+pom1-om1*pom2
3125 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3128 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3129 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3130 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3131 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3134 C Calculate the components of the gradient in DC and X
3138 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3143 C--------------------------------------------------------------------------
3144 subroutine ebond(estr)
3146 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3148 implicit real*8 (a-h,o-z)
3149 include 'DIMENSIONS'
3150 include 'sizesclu.dat'
3151 include 'COMMON.LOCAL'
3152 include 'COMMON.GEO'
3153 include 'COMMON.INTERACT'
3154 include 'COMMON.DERIV'
3155 include 'COMMON.VAR'
3156 include 'COMMON.CHAIN'
3157 include 'COMMON.IOUNITS'
3158 include 'COMMON.NAMES'
3159 include 'COMMON.FFIELD'
3160 include 'COMMON.CONTROL'
3161 logical energy_dec /.false./
3162 double precision u(3),ud(3)
3166 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3167 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3169 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3170 & *dc(j,i-1)/vbld(i)
3172 if (energy_dec) write(iout,*)
3173 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
3175 diff = vbld(i)-vbldp0
3176 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3179 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3184 estr=0.5d0*AKP*estr+estr1
3186 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3190 if (iti.ne.10 .and. iti.ne.ntyp1) then
3193 diff=vbld(i+nres)-vbldsc0(1,iti)
3194 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3195 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3196 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3198 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3202 diff=vbld(i+nres)-vbldsc0(j,iti)
3203 ud(j)=aksc(j,iti)*diff
3204 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3218 uprod2=uprod2*u(k)*u(k)
3222 usumsqder=usumsqder+ud(j)*uprod2
3224 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3225 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3226 estr=estr+uprod/usum
3228 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3236 C--------------------------------------------------------------------------
3237 subroutine ebend(etheta,ethetacnstr)
3239 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3240 C angles gamma and its derivatives in consecutive thetas and gammas.
3242 implicit real*8 (a-h,o-z)
3243 include 'DIMENSIONS'
3244 include 'sizesclu.dat'
3245 include 'COMMON.LOCAL'
3246 include 'COMMON.GEO'
3247 include 'COMMON.INTERACT'
3248 include 'COMMON.DERIV'
3249 include 'COMMON.VAR'
3250 include 'COMMON.CHAIN'
3251 include 'COMMON.IOUNITS'
3252 include 'COMMON.NAMES'
3253 include 'COMMON.FFIELD'
3254 include 'COMMON.TORCNSTR'
3255 common /calcthet/ term1,term2,termm,diffak,ratak,
3256 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3257 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3258 double precision y(2),z(2)
3260 c time11=dexp(-2*time)
3263 c write (iout,*) "nres",nres
3264 c write (*,'(a,i2)') 'EBEND ICG=',icg
3265 c write (iout,*) ithet_start,ithet_end
3266 do i=ithet_start,ithet_end
3267 if (itype(i-1).eq.ntyp1) cycle
3268 C Zero the energy function and its derivative at 0 or pi.
3269 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3271 ichir1=isign(1,itype(i-2))
3272 ichir2=isign(1,itype(i))
3273 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3274 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3275 if (itype(i-1).eq.10) then
3276 itype1=isign(10,itype(i-2))
3277 ichir11=isign(1,itype(i-2))
3278 ichir12=isign(1,itype(i-2))
3279 itype2=isign(10,itype(i))
3280 ichir21=isign(1,itype(i))
3281 ichir22=isign(1,itype(i))
3283 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3287 c call proc_proc(phii,icrc)
3288 if (icrc.eq.1) phii=150.0
3298 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3302 c call proc_proc(phii1,icrc)
3303 if (icrc.eq.1) phii1=150.0
3315 C Calculate the "mean" value of theta from the part of the distribution
3316 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3317 C In following comments this theta will be referred to as t_c.
3318 thet_pred_mean=0.0d0
3320 athetk=athet(k,it,ichir1,ichir2)
3321 bthetk=bthet(k,it,ichir1,ichir2)
3323 athetk=athet(k,itype1,ichir11,ichir12)
3324 bthetk=bthet(k,itype2,ichir21,ichir22)
3326 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3328 c write (iout,*) "thet_pred_mean",thet_pred_mean
3329 dthett=thet_pred_mean*ssd
3330 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3331 c write (iout,*) "thet_pred_mean",thet_pred_mean
3332 C Derivatives of the "mean" values in gamma1 and gamma2.
3333 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3334 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3335 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3336 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3338 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3339 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3340 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3341 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3343 if (theta(i).gt.pi-delta) then
3344 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3346 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3347 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3348 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3350 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3352 else if (theta(i).lt.delta) then
3353 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3354 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3355 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3357 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3358 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3361 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3364 etheta=etheta+ethetai
3365 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3366 c & rad2deg*phii,rad2deg*phii1,ethetai
3367 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3368 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3369 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3372 C Ufff.... We've done all this!!!
3375 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
3376 do i=1,ntheta_constr
3377 itheta=itheta_constr(i)
3378 thetiii=theta(itheta)
3379 difi=pinorm(thetiii-theta_constr0(i))
3380 if (difi.gt.theta_drange(i)) then
3381 difi=difi-theta_drange(i)
3382 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3383 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3384 & +for_thet_constr(i)*difi**3
3385 else if (difi.lt.-drange(i)) then
3387 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3388 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3389 & +for_thet_constr(i)*difi**3
3393 C if (energy_dec) then
3394 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
3395 C & i,itheta,rad2deg*thetiii,
3396 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
3397 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
3398 C & gloc(itheta+nphi-2,icg)
3403 C---------------------------------------------------------------------------
3404 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3406 implicit real*8 (a-h,o-z)
3407 include 'DIMENSIONS'
3408 include 'COMMON.LOCAL'
3409 include 'COMMON.IOUNITS'
3410 common /calcthet/ term1,term2,termm,diffak,ratak,
3411 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3412 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3413 C Calculate the contributions to both Gaussian lobes.
3414 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3415 C The "polynomial part" of the "standard deviation" of this part of
3419 sig=sig*thet_pred_mean+polthet(j,it)
3421 C Derivative of the "interior part" of the "standard deviation of the"
3422 C gamma-dependent Gaussian lobe in t_c.
3423 sigtc=3*polthet(3,it)
3425 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3428 C Set the parameters of both Gaussian lobes of the distribution.
3429 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3430 fac=sig*sig+sigc0(it)
3433 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3434 sigsqtc=-4.0D0*sigcsq*sigtc
3435 c print *,i,sig,sigtc,sigsqtc
3436 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3437 sigtc=-sigtc/(fac*fac)
3438 C Following variable is sigma(t_c)**(-2)
3439 sigcsq=sigcsq*sigcsq
3441 sig0inv=1.0D0/sig0i**2
3442 delthec=thetai-thet_pred_mean
3443 delthe0=thetai-theta0i
3444 term1=-0.5D0*sigcsq*delthec*delthec
3445 term2=-0.5D0*sig0inv*delthe0*delthe0
3446 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3447 C NaNs in taking the logarithm. We extract the largest exponent which is added
3448 C to the energy (this being the log of the distribution) at the end of energy
3449 C term evaluation for this virtual-bond angle.
3450 if (term1.gt.term2) then
3452 term2=dexp(term2-termm)
3456 term1=dexp(term1-termm)
3459 C The ratio between the gamma-independent and gamma-dependent lobes of
3460 C the distribution is a Gaussian function of thet_pred_mean too.
3461 diffak=gthet(2,it)-thet_pred_mean
3462 ratak=diffak/gthet(3,it)**2
3463 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3464 C Let's differentiate it in thet_pred_mean NOW.
3466 C Now put together the distribution terms to make complete distribution.
3467 termexp=term1+ak*term2
3468 termpre=sigc+ak*sig0i
3469 C Contribution of the bending energy from this theta is just the -log of
3470 C the sum of the contributions from the two lobes and the pre-exponential
3471 C factor. Simple enough, isn't it?
3472 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3473 C NOW the derivatives!!!
3474 C 6/6/97 Take into account the deformation.
3475 E_theta=(delthec*sigcsq*term1
3476 & +ak*delthe0*sig0inv*term2)/termexp
3477 E_tc=((sigtc+aktc*sig0i)/termpre
3478 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3479 & aktc*term2)/termexp)
3482 c-----------------------------------------------------------------------------
3483 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3484 implicit real*8 (a-h,o-z)
3485 include 'DIMENSIONS'
3486 include 'COMMON.LOCAL'
3487 include 'COMMON.IOUNITS'
3488 common /calcthet/ term1,term2,termm,diffak,ratak,
3489 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3490 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3491 delthec=thetai-thet_pred_mean
3492 delthe0=thetai-theta0i
3493 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3494 t3 = thetai-thet_pred_mean
3498 t14 = t12+t6*sigsqtc
3500 t21 = thetai-theta0i
3506 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3507 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3508 & *(-t12*t9-ak*sig0inv*t27)
3512 C--------------------------------------------------------------------------
3513 subroutine ebend(etheta,ethetacnstr)
3515 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3516 C angles gamma and its derivatives in consecutive thetas and gammas.
3517 C ab initio-derived potentials from
3518 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3520 implicit real*8 (a-h,o-z)
3521 include 'DIMENSIONS'
3522 include 'sizesclu.dat'
3523 include 'COMMON.LOCAL'
3524 include 'COMMON.GEO'
3525 include 'COMMON.INTERACT'
3526 include 'COMMON.DERIV'
3527 include 'COMMON.VAR'
3528 include 'COMMON.CHAIN'
3529 include 'COMMON.IOUNITS'
3530 include 'COMMON.NAMES'
3531 include 'COMMON.FFIELD'
3532 include 'COMMON.CONTROL'
3533 include 'COMMON.TORCNSTR'
3534 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3535 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3536 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3537 & sinph1ph2(maxdouble,maxdouble)
3538 logical lprn /.false./, lprn1 /.false./
3540 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3541 do i=ithet_start,ithet_end
3542 c if (itype(i-1).eq.ntyp1) cycle
3543 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3544 &(itype(i).eq.ntyp1)) cycle
3545 if (iabs(itype(i+1)).eq.20) iblock=2
3546 if (iabs(itype(i+1)).ne.20) iblock=1
3550 theti2=0.5d0*theta(i)
3551 CC Ta zmina jest niewlasciwa
3552 ityp2=ithetyp((itype(i-1)))
3554 coskt(k)=dcos(k*theti2)
3555 sinkt(k)=dsin(k*theti2)
3557 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3560 if (phii.ne.phii) phii=150.0
3564 ityp1=ithetyp((itype(i-2)))
3566 cosph1(k)=dcos(k*phii)
3567 sinph1(k)=dsin(k*phii)
3573 ityp1=ithetyp((itype(i-2)))
3578 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3581 if (phii1.ne.phii1) phii1=150.0
3586 ityp3=ithetyp((itype(i)))
3588 cosph2(k)=dcos(k*phii1)
3589 sinph2(k)=dsin(k*phii1)
3594 ityp3=ithetyp((itype(i)))
3600 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3601 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3603 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3606 ccl=cosph1(l)*cosph2(k-l)
3607 ssl=sinph1(l)*sinph2(k-l)
3608 scl=sinph1(l)*cosph2(k-l)
3609 csl=cosph1(l)*sinph2(k-l)
3610 cosph1ph2(l,k)=ccl-ssl
3611 cosph1ph2(k,l)=ccl+ssl
3612 sinph1ph2(l,k)=scl+csl
3613 sinph1ph2(k,l)=scl-csl
3617 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3618 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3619 write (iout,*) "coskt and sinkt"
3621 write (iout,*) k,coskt(k),sinkt(k)
3625 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3626 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3629 & write (iout,*) "k",k," aathet",
3630 & aathet(k,ityp1,ityp2,ityp3,iblock),
3631 & " ethetai",ethetai
3634 write (iout,*) "cosph and sinph"
3636 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3638 write (iout,*) "cosph1ph2 and sinph2ph2"
3641 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3642 & sinph1ph2(l,k),sinph1ph2(k,l)
3645 write(iout,*) "ethetai",ethetai
3649 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3650 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3651 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3652 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3653 ethetai=ethetai+sinkt(m)*aux
3654 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3655 dephii=dephii+k*sinkt(m)*(
3656 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3657 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3658 dephii1=dephii1+k*sinkt(m)*(
3659 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3660 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3662 & write (iout,*) "m",m," k",k," bbthet",
3663 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3664 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3665 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3666 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3670 & write(iout,*) "ethetai",ethetai
3674 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3675 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3676 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3677 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3678 ethetai=ethetai+sinkt(m)*aux
3679 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3680 dephii=dephii+l*sinkt(m)*(
3681 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3682 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3683 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3684 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3685 dephii1=dephii1+(k-l)*sinkt(m)*(
3686 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3687 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3688 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3689 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3691 write (iout,*) "m",m," k",k," l",l," ffthet",
3692 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3693 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3694 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3695 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3696 & " ethetai",ethetai
3697 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3698 & cosph1ph2(k,l)*sinkt(m),
3699 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3705 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3706 & i,theta(i)*rad2deg,phii*rad2deg,
3707 & phii1*rad2deg,ethetai
3708 etheta=etheta+ethetai
3709 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3710 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3711 c gloc(nphi+i-2,icg)=wang*dethetai
3712 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3716 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
3717 do i=1,ntheta_constr
3718 itheta=itheta_constr(i)
3719 thetiii=theta(itheta)
3720 difi=pinorm(thetiii-theta_constr0(i))
3721 if (difi.gt.theta_drange(i)) then
3722 difi=difi-theta_drange(i)
3723 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3724 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3725 & +for_thet_constr(i)*difi**3
3726 else if (difi.lt.-drange(i)) then
3728 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3729 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3730 & +for_thet_constr(i)*difi**3
3734 C if (energy_dec) then
3735 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
3736 C & i,itheta,rad2deg*thetiii,
3737 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
3738 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
3739 C & gloc(itheta+nphi-2,icg)
3746 c-----------------------------------------------------------------------------
3747 subroutine esc(escloc)
3748 C Calculate the local energy of a side chain and its derivatives in the
3749 C corresponding virtual-bond valence angles THETA and the spherical angles
3751 implicit real*8 (a-h,o-z)
3752 include 'DIMENSIONS'
3753 include 'sizesclu.dat'
3754 include 'COMMON.GEO'
3755 include 'COMMON.LOCAL'
3756 include 'COMMON.VAR'
3757 include 'COMMON.INTERACT'
3758 include 'COMMON.DERIV'
3759 include 'COMMON.CHAIN'
3760 include 'COMMON.IOUNITS'
3761 include 'COMMON.NAMES'
3762 include 'COMMON.FFIELD'
3763 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3764 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3765 common /sccalc/ time11,time12,time112,theti,it,nlobit
3768 c write (iout,'(a)') 'ESC'
3769 do i=loc_start,loc_end
3771 if (it.eq.ntyp1) cycle
3772 if (it.eq.10) goto 1
3773 nlobit=nlob(iabs(it))
3774 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3775 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3776 theti=theta(i+1)-pipol
3780 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3782 if (x(2).gt.pi-delta) then
3786 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3788 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3789 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3791 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3792 & ddersc0(1),dersc(1))
3793 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3794 & ddersc0(3),dersc(3))
3796 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3798 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3799 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3800 & dersc0(2),esclocbi,dersc02)
3801 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3803 call splinthet(x(2),0.5d0*delta,ss,ssd)
3808 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3810 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3811 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3813 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3815 c write (iout,*) escloci
3816 else if (x(2).lt.delta) then
3820 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3822 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3823 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3825 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3826 & ddersc0(1),dersc(1))
3827 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3828 & ddersc0(3),dersc(3))
3830 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3832 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3833 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3834 & dersc0(2),esclocbi,dersc02)
3835 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3840 call splinthet(x(2),0.5d0*delta,ss,ssd)
3842 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3844 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3845 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3847 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3848 c write (iout,*) escloci
3850 call enesc(x,escloci,dersc,ddummy,.false.)
3853 escloc=escloc+escloci
3854 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3856 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3858 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3859 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3864 C---------------------------------------------------------------------------
3865 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3866 implicit real*8 (a-h,o-z)
3867 include 'DIMENSIONS'
3868 include 'COMMON.GEO'
3869 include 'COMMON.LOCAL'
3870 include 'COMMON.IOUNITS'
3871 common /sccalc/ time11,time12,time112,theti,it,nlobit
3872 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3873 double precision contr(maxlob,-1:1)
3875 c write (iout,*) 'it=',it,' nlobit=',nlobit
3879 if (mixed) ddersc(j)=0.0d0
3883 C Because of periodicity of the dependence of the SC energy in omega we have
3884 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3885 C To avoid underflows, first compute & store the exponents.
3893 z(k)=x(k)-censc(k,j,it)
3898 Axk=Axk+gaussc(l,k,j,it)*z(l)
3904 expfac=expfac+Ax(k,j,iii)*z(k)
3912 C As in the case of ebend, we want to avoid underflows in exponentiation and
3913 C subsequent NaNs and INFs in energy calculation.
3914 C Find the largest exponent
3918 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3922 cd print *,'it=',it,' emin=',emin
3924 C Compute the contribution to SC energy and derivatives
3928 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3929 cd print *,'j=',j,' expfac=',expfac
3930 escloc_i=escloc_i+expfac
3932 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3936 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3937 & +gaussc(k,2,j,it))*expfac
3944 dersc(1)=dersc(1)/cos(theti)**2
3945 ddersc(1)=ddersc(1)/cos(theti)**2
3948 escloci=-(dlog(escloc_i)-emin)
3950 dersc(j)=dersc(j)/escloc_i
3954 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3959 C------------------------------------------------------------------------------
3960 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3961 implicit real*8 (a-h,o-z)
3962 include 'DIMENSIONS'
3963 include 'COMMON.GEO'
3964 include 'COMMON.LOCAL'
3965 include 'COMMON.IOUNITS'
3966 common /sccalc/ time11,time12,time112,theti,it,nlobit
3967 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3968 double precision contr(maxlob)
3979 z(k)=x(k)-censc(k,j,it)
3985 Axk=Axk+gaussc(l,k,j,it)*z(l)
3991 expfac=expfac+Ax(k,j)*z(k)
3996 C As in the case of ebend, we want to avoid underflows in exponentiation and
3997 C subsequent NaNs and INFs in energy calculation.
3998 C Find the largest exponent
4001 if (emin.gt.contr(j)) emin=contr(j)
4005 C Compute the contribution to SC energy and derivatives
4009 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4010 escloc_i=escloc_i+expfac
4012 dersc(k)=dersc(k)+Ax(k,j)*expfac
4014 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4015 & +gaussc(1,2,j,it))*expfac
4019 dersc(1)=dersc(1)/cos(theti)**2
4020 dersc12=dersc12/cos(theti)**2
4021 escloci=-(dlog(escloc_i)-emin)
4023 dersc(j)=dersc(j)/escloc_i
4025 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4029 c----------------------------------------------------------------------------------
4030 subroutine esc(escloc)
4031 C Calculate the local energy of a side chain and its derivatives in the
4032 C corresponding virtual-bond valence angles THETA and the spherical angles
4033 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4034 C added by Urszula Kozlowska. 07/11/2007
4036 implicit real*8 (a-h,o-z)
4037 include 'DIMENSIONS'
4038 include 'sizesclu.dat'
4039 include 'COMMON.GEO'
4040 include 'COMMON.LOCAL'
4041 include 'COMMON.VAR'
4042 include 'COMMON.SCROT'
4043 include 'COMMON.INTERACT'
4044 include 'COMMON.DERIV'
4045 include 'COMMON.CHAIN'
4046 include 'COMMON.IOUNITS'
4047 include 'COMMON.NAMES'
4048 include 'COMMON.FFIELD'
4049 include 'COMMON.CONTROL'
4050 include 'COMMON.VECTORS'
4051 double precision x_prime(3),y_prime(3),z_prime(3)
4052 & , sumene,dsc_i,dp2_i,x(65),
4053 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4054 & de_dxx,de_dyy,de_dzz,de_dt
4055 double precision s1_t,s1_6_t,s2_t,s2_6_t
4057 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4058 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4059 & dt_dCi(3),dt_dCi1(3)
4060 common /sccalc/ time11,time12,time112,theti,it,nlobit
4063 do i=loc_start,loc_end
4064 if (itype(i).eq.ntyp1) cycle
4065 costtab(i+1) =dcos(theta(i+1))
4066 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4067 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4068 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4069 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4070 cosfac=dsqrt(cosfac2)
4071 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4072 sinfac=dsqrt(sinfac2)
4074 if (it.eq.10) goto 1
4076 C Compute the axes of tghe local cartesian coordinates system; store in
4077 c x_prime, y_prime and z_prime
4084 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4085 C & dc_norm(3,i+nres)
4087 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4088 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4091 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4094 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4095 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4096 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4097 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4098 c & " xy",scalar(x_prime(1),y_prime(1)),
4099 c & " xz",scalar(x_prime(1),z_prime(1)),
4100 c & " yy",scalar(y_prime(1),y_prime(1)),
4101 c & " yz",scalar(y_prime(1),z_prime(1)),
4102 c & " zz",scalar(z_prime(1),z_prime(1))
4104 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4105 C to local coordinate system. Store in xx, yy, zz.
4111 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4112 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4113 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4120 C Compute the energy of the ith side cbain
4122 c write (2,*) "xx",xx," yy",yy," zz",zz
4125 x(j) = sc_parmin(j,it)
4128 Cc diagnostics - remove later
4130 yy1 = dsin(alph(2))*dcos(omeg(2))
4131 c zz1 = -dsin(alph(2))*dsin(omeg(2))
4132 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4133 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4134 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4136 C," --- ", xx_w,yy_w,zz_w
4139 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4140 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4142 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4143 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4145 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4146 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4147 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4148 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4149 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4151 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4152 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4153 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4154 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4155 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4157 dsc_i = 0.743d0+x(61)
4159 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4160 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4161 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4162 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4163 s1=(1+x(63))/(0.1d0 + dscp1)
4164 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4165 s2=(1+x(65))/(0.1d0 + dscp2)
4166 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4167 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4168 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4169 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4171 c & dscp1,dscp2,sumene
4172 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4173 escloc = escloc + sumene
4174 c write (2,*) "escloc",escloc
4175 if (.not. calc_grad) goto 1
4178 C This section to check the numerical derivatives of the energy of ith side
4179 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4180 C #define DEBUG in the code to turn it on.
4182 write (2,*) "sumene =",sumene
4186 write (2,*) xx,yy,zz
4187 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4188 de_dxx_num=(sumenep-sumene)/aincr
4190 write (2,*) "xx+ sumene from enesc=",sumenep
4193 write (2,*) xx,yy,zz
4194 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4195 de_dyy_num=(sumenep-sumene)/aincr
4197 write (2,*) "yy+ sumene from enesc=",sumenep
4200 write (2,*) xx,yy,zz
4201 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4202 de_dzz_num=(sumenep-sumene)/aincr
4204 write (2,*) "zz+ sumene from enesc=",sumenep
4205 costsave=cost2tab(i+1)
4206 sintsave=sint2tab(i+1)
4207 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4208 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4209 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4210 de_dt_num=(sumenep-sumene)/aincr
4211 write (2,*) " t+ sumene from enesc=",sumenep
4212 cost2tab(i+1)=costsave
4213 sint2tab(i+1)=sintsave
4214 C End of diagnostics section.
4217 C Compute the gradient of esc
4219 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4220 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4221 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4222 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4223 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4224 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4225 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4226 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4227 pom1=(sumene3*sint2tab(i+1)+sumene1)
4228 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4229 pom2=(sumene4*cost2tab(i+1)+sumene2)
4230 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4231 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4232 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4233 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4235 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4236 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4237 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4239 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4240 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4241 & +(pom1+pom2)*pom_dx
4243 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4246 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4247 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4248 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4250 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4251 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4252 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4253 & +x(59)*zz**2 +x(60)*xx*zz
4254 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4255 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4256 & +(pom1-pom2)*pom_dy
4258 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4261 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4262 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4263 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4264 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4265 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4266 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4267 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4268 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4270 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4273 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4274 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4275 & +pom1*pom_dt1+pom2*pom_dt2
4277 write(2,*), "de_dt = ", de_dt,de_dt_num
4281 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4282 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4283 cosfac2xx=cosfac2*xx
4284 sinfac2yy=sinfac2*yy
4286 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4288 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4290 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4291 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4292 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4293 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4294 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4295 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4296 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4297 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4298 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4299 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4303 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4304 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4305 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4306 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4309 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4310 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4311 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4313 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4314 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4318 dXX_Ctab(k,i)=dXX_Ci(k)
4319 dXX_C1tab(k,i)=dXX_Ci1(k)
4320 dYY_Ctab(k,i)=dYY_Ci(k)
4321 dYY_C1tab(k,i)=dYY_Ci1(k)
4322 dZZ_Ctab(k,i)=dZZ_Ci(k)
4323 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4324 dXX_XYZtab(k,i)=dXX_XYZ(k)
4325 dYY_XYZtab(k,i)=dYY_XYZ(k)
4326 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4330 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4331 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4332 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4333 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4334 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4336 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4337 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4338 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4339 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4340 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4341 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4342 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4343 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4345 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4346 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4348 C to check gradient call subroutine check_grad
4355 c------------------------------------------------------------------------------
4356 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4358 C This procedure calculates two-body contact function g(rij) and its derivative:
4361 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4364 C where x=(rij-r0ij)/delta
4366 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4369 double precision rij,r0ij,eps0ij,fcont,fprimcont
4370 double precision x,x2,x4,delta
4374 if (x.lt.-1.0D0) then
4377 else if (x.le.1.0D0) then
4380 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4381 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4388 c------------------------------------------------------------------------------
4389 subroutine splinthet(theti,delta,ss,ssder)
4390 implicit real*8 (a-h,o-z)
4391 include 'DIMENSIONS'
4392 include 'sizesclu.dat'
4393 include 'COMMON.VAR'
4394 include 'COMMON.GEO'
4397 if (theti.gt.pipol) then
4398 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4400 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4405 c------------------------------------------------------------------------------
4406 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4408 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4409 double precision ksi,ksi2,ksi3,a1,a2,a3
4410 a1=fprim0*delta/(f1-f0)
4416 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4417 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4420 c------------------------------------------------------------------------------
4421 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4423 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4424 double precision ksi,ksi2,ksi3,a1,a2,a3
4429 a2=3*(f1x-f0x)-2*fprim0x*delta
4430 a3=fprim0x*delta-2*(f1x-f0x)
4431 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4434 C-----------------------------------------------------------------------------
4436 C-----------------------------------------------------------------------------
4437 subroutine etor(etors,edihcnstr,fact)
4438 implicit real*8 (a-h,o-z)
4439 include 'DIMENSIONS'
4440 include 'sizesclu.dat'
4441 include 'COMMON.VAR'
4442 include 'COMMON.GEO'
4443 include 'COMMON.LOCAL'
4444 include 'COMMON.TORSION'
4445 include 'COMMON.INTERACT'
4446 include 'COMMON.DERIV'
4447 include 'COMMON.CHAIN'
4448 include 'COMMON.NAMES'
4449 include 'COMMON.IOUNITS'
4450 include 'COMMON.FFIELD'
4451 include 'COMMON.TORCNSTR'
4453 C Set lprn=.true. for debugging
4457 do i=iphi_start,iphi_end
4458 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4459 & .or. itype(i).eq.ntyp1) cycle
4460 itori=itortyp(itype(i-2))
4461 itori1=itortyp(itype(i-1))
4464 C Proline-Proline pair is a special case...
4465 if (itori.eq.3 .and. itori1.eq.3) then
4466 if (phii.gt.-dwapi3) then
4468 fac=1.0D0/(1.0D0-cosphi)
4469 etorsi=v1(1,3,3)*fac
4470 etorsi=etorsi+etorsi
4471 etors=etors+etorsi-v1(1,3,3)
4472 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4475 v1ij=v1(j+1,itori,itori1)
4476 v2ij=v2(j+1,itori,itori1)
4479 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4480 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4484 v1ij=v1(j,itori,itori1)
4485 v2ij=v2(j,itori,itori1)
4488 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4489 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4493 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4494 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4495 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4496 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4497 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4499 ! 6/20/98 - dihedral angle constraints
4502 itori=idih_constr(i)
4505 if (difi.gt.drange(i)) then
4507 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4508 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4509 else if (difi.lt.-drange(i)) then
4511 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4512 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4514 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4515 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4517 ! write (iout,*) 'edihcnstr',edihcnstr
4520 c------------------------------------------------------------------------------
4522 subroutine etor(etors,edihcnstr,fact)
4523 implicit real*8 (a-h,o-z)
4524 include 'DIMENSIONS'
4525 include 'sizesclu.dat'
4526 include 'COMMON.VAR'
4527 include 'COMMON.GEO'
4528 include 'COMMON.LOCAL'
4529 include 'COMMON.TORSION'
4530 include 'COMMON.INTERACT'
4531 include 'COMMON.DERIV'
4532 include 'COMMON.CHAIN'
4533 include 'COMMON.NAMES'
4534 include 'COMMON.IOUNITS'
4535 include 'COMMON.FFIELD'
4536 include 'COMMON.TORCNSTR'
4538 C Set lprn=.true. for debugging
4542 do i=iphi_start,iphi_end
4543 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4544 & .or. itype(i).eq.ntyp1) cycle
4545 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4546 if (iabs(itype(i)).eq.20) then
4551 itori=itortyp(itype(i-2))
4552 itori1=itortyp(itype(i-1))
4555 C Regular cosine and sine terms
4556 do j=1,nterm(itori,itori1,iblock)
4557 v1ij=v1(j,itori,itori1,iblock)
4558 v2ij=v2(j,itori,itori1,iblock)
4561 etors=etors+v1ij*cosphi+v2ij*sinphi
4562 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4566 C E = SUM ----------------------------------- - v1
4567 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4569 cosphi=dcos(0.5d0*phii)
4570 sinphi=dsin(0.5d0*phii)
4571 do j=1,nlor(itori,itori1,iblock)
4572 vl1ij=vlor1(j,itori,itori1)
4573 vl2ij=vlor2(j,itori,itori1)
4574 vl3ij=vlor3(j,itori,itori1)
4575 pom=vl2ij*cosphi+vl3ij*sinphi
4576 pom1=1.0d0/(pom*pom+1.0d0)
4577 etors=etors+vl1ij*pom1
4579 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4581 C Subtract the constant term
4582 etors=etors-v0(itori,itori1,iblock)
4584 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4585 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4586 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4587 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4588 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4591 ! 6/20/98 - dihedral angle constraints
4594 itori=idih_constr(i)
4596 difi=pinorm(phii-phi0(i))
4598 if (difi.gt.drange(i)) then
4600 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4601 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4602 edihi=0.25d0*ftors(i)*difi**4
4603 else if (difi.lt.-drange(i)) then
4605 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4606 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4607 edihi=0.25d0*ftors(i)*difi**4
4611 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4613 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4614 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4616 ! write (iout,*) 'edihcnstr',edihcnstr
4619 c----------------------------------------------------------------------------
4620 subroutine etor_d(etors_d,fact2)
4621 C 6/23/01 Compute double torsional energy
4622 implicit real*8 (a-h,o-z)
4623 include 'DIMENSIONS'
4624 include 'sizesclu.dat'
4625 include 'COMMON.VAR'
4626 include 'COMMON.GEO'
4627 include 'COMMON.LOCAL'
4628 include 'COMMON.TORSION'
4629 include 'COMMON.INTERACT'
4630 include 'COMMON.DERIV'
4631 include 'COMMON.CHAIN'
4632 include 'COMMON.NAMES'
4633 include 'COMMON.IOUNITS'
4634 include 'COMMON.FFIELD'
4635 include 'COMMON.TORCNSTR'
4637 C Set lprn=.true. for debugging
4641 do i=iphi_start,iphi_end-1
4642 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4643 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4644 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4646 itori=itortyp(itype(i-2))
4647 itori1=itortyp(itype(i-1))
4648 itori2=itortyp(itype(i))
4654 if (iabs(itype(i+1)).eq.20) iblock=2
4655 C Regular cosine and sine terms
4656 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4657 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4658 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4659 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4660 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4661 cosphi1=dcos(j*phii)
4662 sinphi1=dsin(j*phii)
4663 cosphi2=dcos(j*phii1)
4664 sinphi2=dsin(j*phii1)
4665 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4666 & v2cij*cosphi2+v2sij*sinphi2
4667 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4668 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4670 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4672 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4673 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4674 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4675 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4676 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4677 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4678 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4679 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4680 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4681 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4682 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4683 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4684 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4685 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4688 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4689 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4695 c------------------------------------------------------------------------------
4696 subroutine eback_sc_corr(esccor)
4697 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4698 c conformational states; temporarily implemented as differences
4699 c between UNRES torsional potentials (dependent on three types of
4700 c residues) and the torsional potentials dependent on all 20 types
4701 c of residues computed from AM1 energy surfaces of terminally-blocked
4702 c amino-acid residues.
4703 implicit real*8 (a-h,o-z)
4704 include 'DIMENSIONS'
4705 include 'sizesclu.dat'
4706 include 'COMMON.VAR'
4707 include 'COMMON.GEO'
4708 include 'COMMON.LOCAL'
4709 include 'COMMON.TORSION'
4710 include 'COMMON.SCCOR'
4711 include 'COMMON.INTERACT'
4712 include 'COMMON.DERIV'
4713 include 'COMMON.CHAIN'
4714 include 'COMMON.NAMES'
4715 include 'COMMON.IOUNITS'
4716 include 'COMMON.FFIELD'
4717 include 'COMMON.CONTROL'
4719 C Set lprn=.true. for debugging
4722 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4724 do i=itau_start,itau_end
4725 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4727 isccori=isccortyp(itype(i-2))
4728 isccori1=isccortyp(itype(i-1))
4730 do intertyp=1,3 !intertyp
4731 cc Added 09 May 2012 (Adasko)
4732 cc Intertyp means interaction type of backbone mainchain correlation:
4733 c 1 = SC...Ca...Ca...Ca
4734 c 2 = Ca...Ca...Ca...SC
4735 c 3 = SC...Ca...Ca...SCi
4737 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4738 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4739 & (itype(i-1).eq.ntyp1)))
4740 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4741 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4742 & .or.(itype(i).eq.ntyp1)))
4743 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4744 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4745 & (itype(i-3).eq.ntyp1)))) cycle
4746 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4747 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4749 do j=1,nterm_sccor(isccori,isccori1)
4750 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4751 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4752 cosphi=dcos(j*tauangle(intertyp,i))
4753 sinphi=dsin(j*tauangle(intertyp,i))
4754 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4755 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4757 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
4758 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
4760 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4761 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4762 & (v1sccor(j,1,itori,itori1),j=1,6),
4763 & (v2sccor(j,1,itori,itori1),j=1,6)
4764 gsccor_loc(i-3)=gloci
4769 c------------------------------------------------------------------------------
4770 subroutine multibody(ecorr)
4771 C This subroutine calculates multi-body contributions to energy following
4772 C the idea of Skolnick et al. If side chains I and J make a contact and
4773 C at the same time side chains I+1 and J+1 make a contact, an extra
4774 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4775 implicit real*8 (a-h,o-z)
4776 include 'DIMENSIONS'
4777 include 'COMMON.IOUNITS'
4778 include 'COMMON.DERIV'
4779 include 'COMMON.INTERACT'
4780 include 'COMMON.CONTACTS'
4781 double precision gx(3),gx1(3)
4784 C Set lprn=.true. for debugging
4788 write (iout,'(a)') 'Contact function values:'
4790 write (iout,'(i2,20(1x,i2,f10.5))')
4791 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4806 num_conti=num_cont(i)
4807 num_conti1=num_cont(i1)
4812 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4813 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4814 cd & ' ishift=',ishift
4815 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4816 C The system gains extra energy.
4817 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4818 endif ! j1==j+-ishift
4827 c------------------------------------------------------------------------------
4828 double precision function esccorr(i,j,k,l,jj,kk)
4829 implicit real*8 (a-h,o-z)
4830 include 'DIMENSIONS'
4831 include 'COMMON.IOUNITS'
4832 include 'COMMON.DERIV'
4833 include 'COMMON.INTERACT'
4834 include 'COMMON.CONTACTS'
4835 double precision gx(3),gx1(3)
4840 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4841 C Calculate the multi-body contribution to energy.
4842 C Calculate multi-body contributions to the gradient.
4843 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4844 cd & k,l,(gacont(m,kk,k),m=1,3)
4846 gx(m) =ekl*gacont(m,jj,i)
4847 gx1(m)=eij*gacont(m,kk,k)
4848 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4849 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4850 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4851 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4855 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4860 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4866 c------------------------------------------------------------------------------
4868 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4869 implicit real*8 (a-h,o-z)
4870 include 'DIMENSIONS'
4871 integer dimen1,dimen2,atom,indx
4872 double precision buffer(dimen1,dimen2)
4873 double precision zapas
4874 common /contacts_hb/ zapas(3,20,maxres,7),
4875 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4876 & num_cont_hb(maxres),jcont_hb(20,maxres)
4877 num_kont=num_cont_hb(atom)
4881 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4884 buffer(i,indx+22)=facont_hb(i,atom)
4885 buffer(i,indx+23)=ees0p(i,atom)
4886 buffer(i,indx+24)=ees0m(i,atom)
4887 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4889 buffer(1,indx+26)=dfloat(num_kont)
4892 c------------------------------------------------------------------------------
4893 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4894 implicit real*8 (a-h,o-z)
4895 include 'DIMENSIONS'
4896 integer dimen1,dimen2,atom,indx
4897 double precision buffer(dimen1,dimen2)
4898 double precision zapas
4899 common /contacts_hb/ zapas(3,20,maxres,7),
4900 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4901 & num_cont_hb(maxres),jcont_hb(20,maxres)
4902 num_kont=buffer(1,indx+26)
4903 num_kont_old=num_cont_hb(atom)
4904 num_cont_hb(atom)=num_kont+num_kont_old
4909 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4912 facont_hb(ii,atom)=buffer(i,indx+22)
4913 ees0p(ii,atom)=buffer(i,indx+23)
4914 ees0m(ii,atom)=buffer(i,indx+24)
4915 jcont_hb(ii,atom)=buffer(i,indx+25)
4919 c------------------------------------------------------------------------------
4921 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4922 C This subroutine calculates multi-body contributions to hydrogen-bonding
4923 implicit real*8 (a-h,o-z)
4924 include 'DIMENSIONS'
4925 include 'sizesclu.dat'
4926 include 'COMMON.IOUNITS'
4928 include 'COMMON.INFO'
4930 include 'COMMON.FFIELD'
4931 include 'COMMON.DERIV'
4932 include 'COMMON.INTERACT'
4933 include 'COMMON.CONTACTS'
4935 parameter (max_cont=maxconts)
4936 parameter (max_dim=2*(8*3+2))
4937 parameter (msglen1=max_cont*max_dim*4)
4938 parameter (msglen2=2*msglen1)
4939 integer source,CorrelType,CorrelID,Error
4940 double precision buffer(max_cont,max_dim)
4942 double precision gx(3),gx1(3)
4945 C Set lprn=.true. for debugging
4950 if (fgProcs.le.1) goto 30
4952 write (iout,'(a)') 'Contact function values:'
4954 write (iout,'(2i3,50(1x,i2,f5.2))')
4955 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4956 & j=1,num_cont_hb(i))
4959 C Caution! Following code assumes that electrostatic interactions concerning
4960 C a given atom are split among at most two processors!
4970 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4973 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4974 if (MyRank.gt.0) then
4975 C Send correlation contributions to the preceding processor
4977 nn=num_cont_hb(iatel_s)
4978 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4979 cd write (iout,*) 'The BUFFER array:'
4981 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4983 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4985 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4986 C Clear the contacts of the atom passed to the neighboring processor
4987 nn=num_cont_hb(iatel_s+1)
4989 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4991 num_cont_hb(iatel_s)=0
4993 cd write (iout,*) 'Processor ',MyID,MyRank,
4994 cd & ' is sending correlation contribution to processor',MyID-1,
4995 cd & ' msglen=',msglen
4996 cd write (*,*) 'Processor ',MyID,MyRank,
4997 cd & ' is sending correlation contribution to processor',MyID-1,
4998 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4999 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5000 cd write (iout,*) 'Processor ',MyID,
5001 cd & ' has sent correlation contribution to processor',MyID-1,
5002 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5003 cd write (*,*) 'Processor ',MyID,
5004 cd & ' has sent correlation contribution to processor',MyID-1,
5005 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5007 endif ! (MyRank.gt.0)
5011 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5012 if (MyRank.lt.fgProcs-1) then
5013 C Receive correlation contributions from the next processor
5015 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5016 cd write (iout,*) 'Processor',MyID,
5017 cd & ' is receiving correlation contribution from processor',MyID+1,
5018 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5019 cd write (*,*) 'Processor',MyID,
5020 cd & ' is receiving correlation contribution from processor',MyID+1,
5021 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5023 do while (nbytes.le.0)
5024 call mp_probe(MyID+1,CorrelType,nbytes)
5026 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5027 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5028 cd write (iout,*) 'Processor',MyID,
5029 cd & ' has received correlation contribution from processor',MyID+1,
5030 cd & ' msglen=',msglen,' nbytes=',nbytes
5031 cd write (iout,*) 'The received BUFFER array:'
5033 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5035 if (msglen.eq.msglen1) then
5036 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5037 else if (msglen.eq.msglen2) then
5038 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5039 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5042 & 'ERROR!!!! message length changed while processing correlations.'
5044 & 'ERROR!!!! message length changed while processing correlations.'
5045 call mp_stopall(Error)
5046 endif ! msglen.eq.msglen1
5047 endif ! MyRank.lt.fgProcs-1
5054 write (iout,'(a)') 'Contact function values:'
5056 write (iout,'(2i3,50(1x,i2,f5.2))')
5057 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5058 & j=1,num_cont_hb(i))
5062 C Remove the loop below after debugging !!!
5069 C Calculate the local-electrostatic correlation terms
5070 do i=iatel_s,iatel_e+1
5072 num_conti=num_cont_hb(i)
5073 num_conti1=num_cont_hb(i+1)
5078 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5079 c & ' jj=',jj,' kk=',kk
5080 if (j1.eq.j+1 .or. j1.eq.j-1) then
5081 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5082 C The system gains extra energy.
5083 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5085 else if (j1.eq.j) then
5086 C Contacts I-J and I-(J+1) occur simultaneously.
5087 C The system loses extra energy.
5088 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5093 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5094 c & ' jj=',jj,' kk=',kk
5096 C Contacts I-J and (I+1)-J occur simultaneously.
5097 C The system loses extra energy.
5098 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5105 c------------------------------------------------------------------------------
5106 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5108 C This subroutine calculates multi-body contributions to hydrogen-bonding
5109 implicit real*8 (a-h,o-z)
5110 include 'DIMENSIONS'
5111 include 'sizesclu.dat'
5112 include 'COMMON.IOUNITS'
5114 include 'COMMON.INFO'
5116 include 'COMMON.FFIELD'
5117 include 'COMMON.DERIV'
5118 include 'COMMON.INTERACT'
5119 include 'COMMON.CONTACTS'
5121 parameter (max_cont=maxconts)
5122 parameter (max_dim=2*(8*3+2))
5123 parameter (msglen1=max_cont*max_dim*4)
5124 parameter (msglen2=2*msglen1)
5125 integer source,CorrelType,CorrelID,Error
5126 double precision buffer(max_cont,max_dim)
5128 double precision gx(3),gx1(3)
5131 C Set lprn=.true. for debugging
5137 if (fgProcs.le.1) goto 30
5139 write (iout,'(a)') 'Contact function values:'
5141 write (iout,'(2i3,50(1x,i2,f5.2))')
5142 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5143 & j=1,num_cont_hb(i))
5146 C Caution! Following code assumes that electrostatic interactions concerning
5147 C a given atom are split among at most two processors!
5157 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5160 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5161 if (MyRank.gt.0) then
5162 C Send correlation contributions to the preceding processor
5164 nn=num_cont_hb(iatel_s)
5165 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5166 cd write (iout,*) 'The BUFFER array:'
5168 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5170 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5172 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5173 C Clear the contacts of the atom passed to the neighboring processor
5174 nn=num_cont_hb(iatel_s+1)
5176 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5178 num_cont_hb(iatel_s)=0
5180 cd write (iout,*) 'Processor ',MyID,MyRank,
5181 cd & ' is sending correlation contribution to processor',MyID-1,
5182 cd & ' msglen=',msglen
5183 cd write (*,*) 'Processor ',MyID,MyRank,
5184 cd & ' is sending correlation contribution to processor',MyID-1,
5185 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5186 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5187 cd write (iout,*) 'Processor ',MyID,
5188 cd & ' has sent correlation contribution to processor',MyID-1,
5189 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5190 cd write (*,*) 'Processor ',MyID,
5191 cd & ' has sent correlation contribution to processor',MyID-1,
5192 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5194 endif ! (MyRank.gt.0)
5198 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5199 if (MyRank.lt.fgProcs-1) then
5200 C Receive correlation contributions from the next processor
5202 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5203 cd write (iout,*) 'Processor',MyID,
5204 cd & ' is receiving correlation contribution from processor',MyID+1,
5205 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5206 cd write (*,*) 'Processor',MyID,
5207 cd & ' is receiving correlation contribution from processor',MyID+1,
5208 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5210 do while (nbytes.le.0)
5211 call mp_probe(MyID+1,CorrelType,nbytes)
5213 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5214 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5215 cd write (iout,*) 'Processor',MyID,
5216 cd & ' has received correlation contribution from processor',MyID+1,
5217 cd & ' msglen=',msglen,' nbytes=',nbytes
5218 cd write (iout,*) 'The received BUFFER array:'
5220 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5222 if (msglen.eq.msglen1) then
5223 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5224 else if (msglen.eq.msglen2) then
5225 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5226 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5229 & 'ERROR!!!! message length changed while processing correlations.'
5231 & 'ERROR!!!! message length changed while processing correlations.'
5232 call mp_stopall(Error)
5233 endif ! msglen.eq.msglen1
5234 endif ! MyRank.lt.fgProcs-1
5241 write (iout,'(a)') 'Contact function values:'
5243 write (iout,'(2i3,50(1x,i2,f5.2))')
5244 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5245 & j=1,num_cont_hb(i))
5251 C Remove the loop below after debugging !!!
5258 C Calculate the dipole-dipole interaction energies
5259 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5260 do i=iatel_s,iatel_e+1
5261 num_conti=num_cont_hb(i)
5268 C Calculate the local-electrostatic correlation terms
5269 do i=iatel_s,iatel_e+1
5271 num_conti=num_cont_hb(i)
5272 num_conti1=num_cont_hb(i+1)
5277 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5278 c & ' jj=',jj,' kk=',kk
5279 if (j1.eq.j+1 .or. j1.eq.j-1) then
5280 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5281 C The system gains extra energy.
5283 sqd1=dsqrt(d_cont(jj,i))
5284 sqd2=dsqrt(d_cont(kk,i1))
5285 sred_geom = sqd1*sqd2
5286 IF (sred_geom.lt.cutoff_corr) THEN
5287 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5289 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5290 c & ' jj=',jj,' kk=',kk
5291 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5292 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5294 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5295 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5298 cd write (iout,*) 'sred_geom=',sred_geom,
5299 cd & ' ekont=',ekont,' fprim=',fprimcont
5300 call calc_eello(i,j,i+1,j1,jj,kk)
5301 if (wcorr4.gt.0.0d0)
5302 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5303 if (wcorr5.gt.0.0d0)
5304 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5305 c print *,"wcorr5",ecorr5
5306 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5307 cd write(2,*)'ijkl',i,j,i+1,j1
5308 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5309 & .or. wturn6.eq.0.0d0))then
5310 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5311 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5312 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5313 cd & 'ecorr6=',ecorr6
5314 cd write (iout,'(4e15.5)') sred_geom,
5315 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5316 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5317 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5318 else if (wturn6.gt.0.0d0
5319 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5320 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5321 eturn6=eturn6+eello_turn6(i,jj,kk)
5322 cd write (2,*) 'multibody_eello:eturn6',eturn6
5326 else if (j1.eq.j) then
5327 C Contacts I-J and I-(J+1) occur simultaneously.
5328 C The system loses extra energy.
5329 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5334 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5335 c & ' jj=',jj,' kk=',kk
5337 C Contacts I-J and (I+1)-J occur simultaneously.
5338 C The system loses extra energy.
5339 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5346 c------------------------------------------------------------------------------
5347 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5348 implicit real*8 (a-h,o-z)
5349 include 'DIMENSIONS'
5350 include 'COMMON.IOUNITS'
5351 include 'COMMON.DERIV'
5352 include 'COMMON.INTERACT'
5353 include 'COMMON.CONTACTS'
5354 double precision gx(3),gx1(3)
5364 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5365 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5366 C Following 4 lines for diagnostics.
5371 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5373 c write (iout,*)'Contacts have occurred for peptide groups',
5374 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5375 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5376 C Calculate the multi-body contribution to energy.
5377 ecorr=ecorr+ekont*ees
5379 C Calculate multi-body contributions to the gradient.
5381 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5382 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5383 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5384 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5385 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5386 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5387 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5388 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5389 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5390 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5391 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5392 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5393 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5394 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5398 gradcorr(ll,m)=gradcorr(ll,m)+
5399 & ees*ekl*gacont_hbr(ll,jj,i)-
5400 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5401 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5406 gradcorr(ll,m)=gradcorr(ll,m)+
5407 & ees*eij*gacont_hbr(ll,kk,k)-
5408 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5409 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5416 C---------------------------------------------------------------------------
5417 subroutine dipole(i,j,jj)
5418 implicit real*8 (a-h,o-z)
5419 include 'DIMENSIONS'
5420 include 'sizesclu.dat'
5421 include 'COMMON.IOUNITS'
5422 include 'COMMON.CHAIN'
5423 include 'COMMON.FFIELD'
5424 include 'COMMON.DERIV'
5425 include 'COMMON.INTERACT'
5426 include 'COMMON.CONTACTS'
5427 include 'COMMON.TORSION'
5428 include 'COMMON.VAR'
5429 include 'COMMON.GEO'
5430 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5432 iti1 = itortyp(itype(i+1))
5433 if (j.lt.nres-1) then
5434 if (itype(j).le.ntyp) then
5435 itj1 = itortyp(itype(j+1))
5443 dipi(iii,1)=Ub2(iii,i)
5444 dipderi(iii)=Ub2der(iii,i)
5445 dipi(iii,2)=b1(iii,iti1)
5446 dipj(iii,1)=Ub2(iii,j)
5447 dipderj(iii)=Ub2der(iii,j)
5448 dipj(iii,2)=b1(iii,itj1)
5452 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5455 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5458 if (.not.calc_grad) return
5463 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5467 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5472 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5473 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5475 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5477 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5479 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5483 C---------------------------------------------------------------------------
5484 subroutine calc_eello(i,j,k,l,jj,kk)
5486 C This subroutine computes matrices and vectors needed to calculate
5487 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5489 implicit real*8 (a-h,o-z)
5490 include 'DIMENSIONS'
5491 include 'sizesclu.dat'
5492 include 'COMMON.IOUNITS'
5493 include 'COMMON.CHAIN'
5494 include 'COMMON.DERIV'
5495 include 'COMMON.INTERACT'
5496 include 'COMMON.CONTACTS'
5497 include 'COMMON.TORSION'
5498 include 'COMMON.VAR'
5499 include 'COMMON.GEO'
5500 include 'COMMON.FFIELD'
5501 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5502 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5505 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5506 cd & ' jj=',jj,' kk=',kk
5507 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5510 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5511 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5514 call transpose2(aa1(1,1),aa1t(1,1))
5515 call transpose2(aa2(1,1),aa2t(1,1))
5518 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5519 & aa1tder(1,1,lll,kkk))
5520 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5521 & aa2tder(1,1,lll,kkk))
5525 C parallel orientation of the two CA-CA-CA frames.
5527 if (i.gt.1 .and. itype(i).le.ntyp) then
5528 iti=itortyp(itype(i))
5532 itk1=itortyp(itype(k+1))
5533 itj=itortyp(itype(j))
5534 c if (l.lt.nres-1) then
5535 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5536 itl1=itortyp(itype(l+1))
5540 C A1 kernel(j+1) A2T
5542 cd write (iout,'(3f10.5,5x,3f10.5)')
5543 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5545 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5546 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5547 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5548 C Following matrices are needed only for 6-th order cumulants
5549 IF (wcorr6.gt.0.0d0) THEN
5550 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5551 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5552 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5553 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5554 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5555 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5556 & ADtEAderx(1,1,1,1,1,1))
5558 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5559 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5560 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5561 & ADtEA1derx(1,1,1,1,1,1))
5563 C End 6-th order cumulants
5566 cd write (2,*) 'In calc_eello6'
5568 cd write (2,*) 'iii=',iii
5570 cd write (2,*) 'kkk=',kkk
5572 cd write (2,'(3(2f10.5),5x)')
5573 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5578 call transpose2(EUgder(1,1,k),auxmat(1,1))
5579 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5580 call transpose2(EUg(1,1,k),auxmat(1,1))
5581 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5582 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5586 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5587 & EAEAderx(1,1,lll,kkk,iii,1))
5591 C A1T kernel(i+1) A2
5592 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5593 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5594 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5595 C Following matrices are needed only for 6-th order cumulants
5596 IF (wcorr6.gt.0.0d0) THEN
5597 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5598 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5599 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5600 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5601 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5602 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5603 & ADtEAderx(1,1,1,1,1,2))
5604 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5605 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5606 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5607 & ADtEA1derx(1,1,1,1,1,2))
5609 C End 6-th order cumulants
5610 call transpose2(EUgder(1,1,l),auxmat(1,1))
5611 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5612 call transpose2(EUg(1,1,l),auxmat(1,1))
5613 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5614 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5618 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5619 & EAEAderx(1,1,lll,kkk,iii,2))
5624 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5625 C They are needed only when the fifth- or the sixth-order cumulants are
5627 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5628 call transpose2(AEA(1,1,1),auxmat(1,1))
5629 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5630 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5631 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5632 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5633 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5634 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5635 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5636 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5637 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5638 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5639 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5640 call transpose2(AEA(1,1,2),auxmat(1,1))
5641 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5642 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5643 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5644 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5645 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5646 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5647 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5648 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5649 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5650 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5651 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5652 C Calculate the Cartesian derivatives of the vectors.
5656 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5657 call matvec2(auxmat(1,1),b1(1,iti),
5658 & AEAb1derx(1,lll,kkk,iii,1,1))
5659 call matvec2(auxmat(1,1),Ub2(1,i),
5660 & AEAb2derx(1,lll,kkk,iii,1,1))
5661 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5662 & AEAb1derx(1,lll,kkk,iii,2,1))
5663 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5664 & AEAb2derx(1,lll,kkk,iii,2,1))
5665 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5666 call matvec2(auxmat(1,1),b1(1,itj),
5667 & AEAb1derx(1,lll,kkk,iii,1,2))
5668 call matvec2(auxmat(1,1),Ub2(1,j),
5669 & AEAb2derx(1,lll,kkk,iii,1,2))
5670 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5671 & AEAb1derx(1,lll,kkk,iii,2,2))
5672 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5673 & AEAb2derx(1,lll,kkk,iii,2,2))
5680 C Antiparallel orientation of the two CA-CA-CA frames.
5682 if (i.gt.1 .and. itype(i).le.ntyp) then
5683 iti=itortyp(itype(i))
5687 itk1=itortyp(itype(k+1))
5688 itl=itortyp(itype(l))
5689 itj=itortyp(itype(j))
5690 c if (j.lt.nres-1) then
5691 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5692 itj1=itortyp(itype(j+1))
5696 C A2 kernel(j-1)T A1T
5697 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5698 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5699 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5700 C Following matrices are needed only for 6-th order cumulants
5701 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5702 & j.eq.i+4 .and. l.eq.i+3)) THEN
5703 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5704 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5705 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5706 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5707 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5708 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5709 & ADtEAderx(1,1,1,1,1,1))
5710 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5711 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5712 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5713 & ADtEA1derx(1,1,1,1,1,1))
5715 C End 6-th order cumulants
5716 call transpose2(EUgder(1,1,k),auxmat(1,1))
5717 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5718 call transpose2(EUg(1,1,k),auxmat(1,1))
5719 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5720 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5724 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5725 & EAEAderx(1,1,lll,kkk,iii,1))
5729 C A2T kernel(i+1)T A1
5730 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5731 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5732 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5733 C Following matrices are needed only for 6-th order cumulants
5734 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5735 & j.eq.i+4 .and. l.eq.i+3)) THEN
5736 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5737 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5738 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5739 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5740 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5741 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5742 & ADtEAderx(1,1,1,1,1,2))
5743 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5744 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5745 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5746 & ADtEA1derx(1,1,1,1,1,2))
5748 C End 6-th order cumulants
5749 call transpose2(EUgder(1,1,j),auxmat(1,1))
5750 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5751 call transpose2(EUg(1,1,j),auxmat(1,1))
5752 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5753 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5757 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5758 & EAEAderx(1,1,lll,kkk,iii,2))
5763 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5764 C They are needed only when the fifth- or the sixth-order cumulants are
5766 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5767 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5768 call transpose2(AEA(1,1,1),auxmat(1,1))
5769 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5770 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5771 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5772 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5773 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5774 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5775 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5776 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5777 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5778 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5779 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5780 call transpose2(AEA(1,1,2),auxmat(1,1))
5781 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5782 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5783 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5784 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5785 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5786 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5787 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5788 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5789 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5790 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5791 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5792 C Calculate the Cartesian derivatives of the vectors.
5796 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5797 call matvec2(auxmat(1,1),b1(1,iti),
5798 & AEAb1derx(1,lll,kkk,iii,1,1))
5799 call matvec2(auxmat(1,1),Ub2(1,i),
5800 & AEAb2derx(1,lll,kkk,iii,1,1))
5801 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5802 & AEAb1derx(1,lll,kkk,iii,2,1))
5803 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5804 & AEAb2derx(1,lll,kkk,iii,2,1))
5805 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5806 call matvec2(auxmat(1,1),b1(1,itl),
5807 & AEAb1derx(1,lll,kkk,iii,1,2))
5808 call matvec2(auxmat(1,1),Ub2(1,l),
5809 & AEAb2derx(1,lll,kkk,iii,1,2))
5810 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5811 & AEAb1derx(1,lll,kkk,iii,2,2))
5812 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5813 & AEAb2derx(1,lll,kkk,iii,2,2))
5822 C---------------------------------------------------------------------------
5823 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5824 & KK,KKderg,AKA,AKAderg,AKAderx)
5828 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5829 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5830 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5835 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5837 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5840 cd if (lprn) write (2,*) 'In kernel'
5842 cd if (lprn) write (2,*) 'kkk=',kkk
5844 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5845 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5847 cd write (2,*) 'lll=',lll
5848 cd write (2,*) 'iii=1'
5850 cd write (2,'(3(2f10.5),5x)')
5851 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5854 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5855 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5857 cd write (2,*) 'lll=',lll
5858 cd write (2,*) 'iii=2'
5860 cd write (2,'(3(2f10.5),5x)')
5861 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5868 C---------------------------------------------------------------------------
5869 double precision function eello4(i,j,k,l,jj,kk)
5870 implicit real*8 (a-h,o-z)
5871 include 'DIMENSIONS'
5872 include 'sizesclu.dat'
5873 include 'COMMON.IOUNITS'
5874 include 'COMMON.CHAIN'
5875 include 'COMMON.DERIV'
5876 include 'COMMON.INTERACT'
5877 include 'COMMON.CONTACTS'
5878 include 'COMMON.TORSION'
5879 include 'COMMON.VAR'
5880 include 'COMMON.GEO'
5881 double precision pizda(2,2),ggg1(3),ggg2(3)
5882 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5886 cd print *,'eello4:',i,j,k,l,jj,kk
5887 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5888 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5889 cold eij=facont_hb(jj,i)
5890 cold ekl=facont_hb(kk,k)
5892 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5894 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5895 gcorr_loc(k-1)=gcorr_loc(k-1)
5896 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5898 gcorr_loc(l-1)=gcorr_loc(l-1)
5899 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5901 gcorr_loc(j-1)=gcorr_loc(j-1)
5902 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5907 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5908 & -EAEAderx(2,2,lll,kkk,iii,1)
5909 cd derx(lll,kkk,iii)=0.0d0
5913 cd gcorr_loc(l-1)=0.0d0
5914 cd gcorr_loc(j-1)=0.0d0
5915 cd gcorr_loc(k-1)=0.0d0
5917 cd write (iout,*)'Contacts have occurred for peptide groups',
5918 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5919 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5920 if (j.lt.nres-1) then
5927 if (l.lt.nres-1) then
5935 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5936 ggg1(ll)=eel4*g_contij(ll,1)
5937 ggg2(ll)=eel4*g_contij(ll,2)
5938 ghalf=0.5d0*ggg1(ll)
5940 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5941 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5942 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5943 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5944 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5945 ghalf=0.5d0*ggg2(ll)
5947 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5948 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5949 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5950 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5955 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5956 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5961 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5962 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5968 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5973 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5977 cd write (2,*) iii,gcorr_loc(iii)
5981 cd write (2,*) 'ekont',ekont
5982 cd write (iout,*) 'eello4',ekont*eel4
5985 C---------------------------------------------------------------------------
5986 double precision function eello5(i,j,k,l,jj,kk)
5987 implicit real*8 (a-h,o-z)
5988 include 'DIMENSIONS'
5989 include 'sizesclu.dat'
5990 include 'COMMON.IOUNITS'
5991 include 'COMMON.CHAIN'
5992 include 'COMMON.DERIV'
5993 include 'COMMON.INTERACT'
5994 include 'COMMON.CONTACTS'
5995 include 'COMMON.TORSION'
5996 include 'COMMON.VAR'
5997 include 'COMMON.GEO'
5998 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5999 double precision ggg1(3),ggg2(3)
6000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6005 C /l\ / \ \ / \ / \ / C
6006 C / \ / \ \ / \ / \ / C
6007 C j| o |l1 | o | o| o | | o |o C
6008 C \ |/k\| |/ \| / |/ \| |/ \| C
6009 C \i/ \ / \ / / \ / \ C
6011 C (I) (II) (III) (IV) C
6013 C eello5_1 eello5_2 eello5_3 eello5_4 C
6015 C Antiparallel chains C
6018 C /j\ / \ \ / \ / \ / C
6019 C / \ / \ \ / \ / \ / C
6020 C j1| o |l | o | o| o | | o |o C
6021 C \ |/k\| |/ \| / |/ \| |/ \| C
6022 C \i/ \ / \ / / \ / \ C
6024 C (I) (II) (III) (IV) C
6026 C eello5_1 eello5_2 eello5_3 eello5_4 C
6028 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6030 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6031 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6036 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6038 itk=itortyp(itype(k))
6039 itl=itortyp(itype(l))
6040 itj=itortyp(itype(j))
6045 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6046 cd & eel5_3_num,eel5_4_num)
6050 derx(lll,kkk,iii)=0.0d0
6054 cd eij=facont_hb(jj,i)
6055 cd ekl=facont_hb(kk,k)
6057 cd write (iout,*)'Contacts have occurred for peptide groups',
6058 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6060 C Contribution from the graph I.
6061 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6062 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6063 call transpose2(EUg(1,1,k),auxmat(1,1))
6064 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6065 vv(1)=pizda(1,1)-pizda(2,2)
6066 vv(2)=pizda(1,2)+pizda(2,1)
6067 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6068 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6070 C Explicit gradient in virtual-dihedral angles.
6071 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6072 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6073 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6074 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6075 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6076 vv(1)=pizda(1,1)-pizda(2,2)
6077 vv(2)=pizda(1,2)+pizda(2,1)
6078 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6079 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6080 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6081 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6082 vv(1)=pizda(1,1)-pizda(2,2)
6083 vv(2)=pizda(1,2)+pizda(2,1)
6085 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6086 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6087 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6089 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6090 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6091 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6093 C Cartesian gradient
6097 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6099 vv(1)=pizda(1,1)-pizda(2,2)
6100 vv(2)=pizda(1,2)+pizda(2,1)
6101 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6102 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6103 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6110 C Contribution from graph II
6111 call transpose2(EE(1,1,itk),auxmat(1,1))
6112 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6113 vv(1)=pizda(1,1)+pizda(2,2)
6114 vv(2)=pizda(2,1)-pizda(1,2)
6115 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6116 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6118 C Explicit gradient in virtual-dihedral angles.
6119 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6120 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6121 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6122 vv(1)=pizda(1,1)+pizda(2,2)
6123 vv(2)=pizda(2,1)-pizda(1,2)
6125 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6126 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6127 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6129 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6130 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6131 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6133 C Cartesian gradient
6137 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6139 vv(1)=pizda(1,1)+pizda(2,2)
6140 vv(2)=pizda(2,1)-pizda(1,2)
6141 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6142 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6143 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6152 C Parallel orientation
6153 C Contribution from graph III
6154 call transpose2(EUg(1,1,l),auxmat(1,1))
6155 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6156 vv(1)=pizda(1,1)-pizda(2,2)
6157 vv(2)=pizda(1,2)+pizda(2,1)
6158 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6159 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6161 C Explicit gradient in virtual-dihedral angles.
6162 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6163 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6164 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6165 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6166 vv(1)=pizda(1,1)-pizda(2,2)
6167 vv(2)=pizda(1,2)+pizda(2,1)
6168 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6169 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6170 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6171 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6172 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6173 vv(1)=pizda(1,1)-pizda(2,2)
6174 vv(2)=pizda(1,2)+pizda(2,1)
6175 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6176 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6177 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6178 C Cartesian gradient
6182 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6184 vv(1)=pizda(1,1)-pizda(2,2)
6185 vv(2)=pizda(1,2)+pizda(2,1)
6186 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6187 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6188 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6194 C Contribution from graph IV
6196 call transpose2(EE(1,1,itl),auxmat(1,1))
6197 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6198 vv(1)=pizda(1,1)+pizda(2,2)
6199 vv(2)=pizda(2,1)-pizda(1,2)
6200 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6201 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6203 C Explicit gradient in virtual-dihedral angles.
6204 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6205 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6206 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6207 vv(1)=pizda(1,1)+pizda(2,2)
6208 vv(2)=pizda(2,1)-pizda(1,2)
6209 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6210 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6211 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6212 C Cartesian gradient
6216 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6218 vv(1)=pizda(1,1)+pizda(2,2)
6219 vv(2)=pizda(2,1)-pizda(1,2)
6220 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6221 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6222 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6228 C Antiparallel orientation
6229 C Contribution from graph III
6231 call transpose2(EUg(1,1,j),auxmat(1,1))
6232 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6233 vv(1)=pizda(1,1)-pizda(2,2)
6234 vv(2)=pizda(1,2)+pizda(2,1)
6235 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6236 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6238 C Explicit gradient in virtual-dihedral angles.
6239 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6240 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6241 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6242 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6243 vv(1)=pizda(1,1)-pizda(2,2)
6244 vv(2)=pizda(1,2)+pizda(2,1)
6245 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6246 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6247 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6248 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6249 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6250 vv(1)=pizda(1,1)-pizda(2,2)
6251 vv(2)=pizda(1,2)+pizda(2,1)
6252 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6253 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6254 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6255 C Cartesian gradient
6259 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6261 vv(1)=pizda(1,1)-pizda(2,2)
6262 vv(2)=pizda(1,2)+pizda(2,1)
6263 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6264 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6265 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6271 C Contribution from graph IV
6273 call transpose2(EE(1,1,itj),auxmat(1,1))
6274 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6275 vv(1)=pizda(1,1)+pizda(2,2)
6276 vv(2)=pizda(2,1)-pizda(1,2)
6277 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6278 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6280 C Explicit gradient in virtual-dihedral angles.
6281 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6282 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6283 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6284 vv(1)=pizda(1,1)+pizda(2,2)
6285 vv(2)=pizda(2,1)-pizda(1,2)
6286 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6287 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6288 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6289 C Cartesian gradient
6293 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6295 vv(1)=pizda(1,1)+pizda(2,2)
6296 vv(2)=pizda(2,1)-pizda(1,2)
6297 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6298 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6299 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6306 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6307 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6308 cd write (2,*) 'ijkl',i,j,k,l
6309 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6310 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6312 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6313 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6314 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6315 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6317 if (j.lt.nres-1) then
6324 if (l.lt.nres-1) then
6334 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6336 ggg1(ll)=eel5*g_contij(ll,1)
6337 ggg2(ll)=eel5*g_contij(ll,2)
6338 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6339 ghalf=0.5d0*ggg1(ll)
6341 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6342 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6343 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6344 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6345 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6346 ghalf=0.5d0*ggg2(ll)
6348 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6349 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6350 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6351 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6356 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6357 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6362 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6363 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6369 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6374 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6378 cd write (2,*) iii,g_corr5_loc(iii)
6382 cd write (2,*) 'ekont',ekont
6383 cd write (iout,*) 'eello5',ekont*eel5
6386 c--------------------------------------------------------------------------
6387 double precision function eello6(i,j,k,l,jj,kk)
6388 implicit real*8 (a-h,o-z)
6389 include 'DIMENSIONS'
6390 include 'sizesclu.dat'
6391 include 'COMMON.IOUNITS'
6392 include 'COMMON.CHAIN'
6393 include 'COMMON.DERIV'
6394 include 'COMMON.INTERACT'
6395 include 'COMMON.CONTACTS'
6396 include 'COMMON.TORSION'
6397 include 'COMMON.VAR'
6398 include 'COMMON.GEO'
6399 include 'COMMON.FFIELD'
6400 double precision ggg1(3),ggg2(3)
6401 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6406 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6414 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6415 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6419 derx(lll,kkk,iii)=0.0d0
6423 cd eij=facont_hb(jj,i)
6424 cd ekl=facont_hb(kk,k)
6430 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6431 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6432 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6433 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6434 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6435 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6437 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6438 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6439 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6440 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6441 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6442 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6446 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6448 C If turn contributions are considered, they will be handled separately.
6449 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6450 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6451 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6452 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6453 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6454 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6455 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6458 if (j.lt.nres-1) then
6465 if (l.lt.nres-1) then
6473 ggg1(ll)=eel6*g_contij(ll,1)
6474 ggg2(ll)=eel6*g_contij(ll,2)
6475 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6476 ghalf=0.5d0*ggg1(ll)
6478 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6479 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6480 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6481 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6482 ghalf=0.5d0*ggg2(ll)
6483 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6485 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6486 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6487 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6488 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6493 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6494 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6499 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6500 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6506 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6511 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6515 cd write (2,*) iii,g_corr6_loc(iii)
6519 cd write (2,*) 'ekont',ekont
6520 cd write (iout,*) 'eello6',ekont*eel6
6523 c--------------------------------------------------------------------------
6524 double precision function eello6_graph1(i,j,k,l,imat,swap)
6525 implicit real*8 (a-h,o-z)
6526 include 'DIMENSIONS'
6527 include 'sizesclu.dat'
6528 include 'COMMON.IOUNITS'
6529 include 'COMMON.CHAIN'
6530 include 'COMMON.DERIV'
6531 include 'COMMON.INTERACT'
6532 include 'COMMON.CONTACTS'
6533 include 'COMMON.TORSION'
6534 include 'COMMON.VAR'
6535 include 'COMMON.GEO'
6536 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6540 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6542 C Parallel Antiparallel C
6548 C \ j|/k\| / \ |/k\|l / C
6553 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6554 itk=itortyp(itype(k))
6555 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6556 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6557 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6558 call transpose2(EUgC(1,1,k),auxmat(1,1))
6559 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6560 vv1(1)=pizda1(1,1)-pizda1(2,2)
6561 vv1(2)=pizda1(1,2)+pizda1(2,1)
6562 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6563 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6564 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6565 s5=scalar2(vv(1),Dtobr2(1,i))
6566 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6567 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6568 if (.not. calc_grad) return
6569 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6570 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6571 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6572 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6573 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6574 & +scalar2(vv(1),Dtobr2der(1,i)))
6575 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6576 vv1(1)=pizda1(1,1)-pizda1(2,2)
6577 vv1(2)=pizda1(1,2)+pizda1(2,1)
6578 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6579 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6581 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6582 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6583 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6584 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6585 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6587 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6588 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6589 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6590 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6591 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6593 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6594 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6595 vv1(1)=pizda1(1,1)-pizda1(2,2)
6596 vv1(2)=pizda1(1,2)+pizda1(2,1)
6597 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6598 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6599 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6600 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6609 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6610 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6611 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6612 call transpose2(EUgC(1,1,k),auxmat(1,1))
6613 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6615 vv1(1)=pizda1(1,1)-pizda1(2,2)
6616 vv1(2)=pizda1(1,2)+pizda1(2,1)
6617 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6618 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6619 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6620 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6621 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6622 s5=scalar2(vv(1),Dtobr2(1,i))
6623 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6629 c----------------------------------------------------------------------------
6630 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6631 implicit real*8 (a-h,o-z)
6632 include 'DIMENSIONS'
6633 include 'sizesclu.dat'
6634 include 'COMMON.IOUNITS'
6635 include 'COMMON.CHAIN'
6636 include 'COMMON.DERIV'
6637 include 'COMMON.INTERACT'
6638 include 'COMMON.CONTACTS'
6639 include 'COMMON.TORSION'
6640 include 'COMMON.VAR'
6641 include 'COMMON.GEO'
6643 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6644 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6647 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6649 C Parallel Antiparallel C
6655 C \ j|/k\| \ |/k\|l C
6660 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6661 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6662 C AL 7/4/01 s1 would occur in the sixth-order moment,
6663 C but not in a cluster cumulant
6665 s1=dip(1,jj,i)*dip(1,kk,k)
6667 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6668 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6669 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6670 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6671 call transpose2(EUg(1,1,k),auxmat(1,1))
6672 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6673 vv(1)=pizda(1,1)-pizda(2,2)
6674 vv(2)=pizda(1,2)+pizda(2,1)
6675 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6676 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6678 eello6_graph2=-(s1+s2+s3+s4)
6680 eello6_graph2=-(s2+s3+s4)
6683 if (.not. calc_grad) return
6684 C Derivatives in gamma(i-1)
6687 s1=dipderg(1,jj,i)*dip(1,kk,k)
6689 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6690 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6691 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6692 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6694 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6696 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6698 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6700 C Derivatives in gamma(k-1)
6702 s1=dip(1,jj,i)*dipderg(1,kk,k)
6704 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6705 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6706 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6707 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6708 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6709 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6710 vv(1)=pizda(1,1)-pizda(2,2)
6711 vv(2)=pizda(1,2)+pizda(2,1)
6712 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6714 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6716 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6718 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6719 C Derivatives in gamma(j-1) or gamma(l-1)
6722 s1=dipderg(3,jj,i)*dip(1,kk,k)
6724 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6725 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6726 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6727 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6728 vv(1)=pizda(1,1)-pizda(2,2)
6729 vv(2)=pizda(1,2)+pizda(2,1)
6730 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6733 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6735 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6738 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6739 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6741 C Derivatives in gamma(l-1) or gamma(j-1)
6744 s1=dip(1,jj,i)*dipderg(3,kk,k)
6746 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6747 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6748 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6749 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6750 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6751 vv(1)=pizda(1,1)-pizda(2,2)
6752 vv(2)=pizda(1,2)+pizda(2,1)
6753 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6756 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6758 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6761 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6762 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6764 C Cartesian derivatives.
6766 write (2,*) 'In eello6_graph2'
6768 write (2,*) 'iii=',iii
6770 write (2,*) 'kkk=',kkk
6772 write (2,'(3(2f10.5),5x)')
6773 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6783 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6785 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6788 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6790 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6791 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6793 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6794 call transpose2(EUg(1,1,k),auxmat(1,1))
6795 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6797 vv(1)=pizda(1,1)-pizda(2,2)
6798 vv(2)=pizda(1,2)+pizda(2,1)
6799 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6800 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6802 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6804 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6807 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6809 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6816 c----------------------------------------------------------------------------
6817 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6818 implicit real*8 (a-h,o-z)
6819 include 'DIMENSIONS'
6820 include 'sizesclu.dat'
6821 include 'COMMON.IOUNITS'
6822 include 'COMMON.CHAIN'
6823 include 'COMMON.DERIV'
6824 include 'COMMON.INTERACT'
6825 include 'COMMON.CONTACTS'
6826 include 'COMMON.TORSION'
6827 include 'COMMON.VAR'
6828 include 'COMMON.GEO'
6829 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6831 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6833 C Parallel Antiparallel C
6839 C j|/k\| / |/k\|l / C
6844 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6846 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6847 C energy moment and not to the cluster cumulant.
6848 iti=itortyp(itype(i))
6849 c if (j.lt.nres-1) then
6850 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6851 itj1=itortyp(itype(j+1))
6855 itk=itortyp(itype(k))
6856 itk1=itortyp(itype(k+1))
6857 c if (l.lt.nres-1) then
6858 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6859 itl1=itortyp(itype(l+1))
6864 s1=dip(4,jj,i)*dip(4,kk,k)
6866 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6867 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6868 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6869 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6870 call transpose2(EE(1,1,itk),auxmat(1,1))
6871 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6872 vv(1)=pizda(1,1)+pizda(2,2)
6873 vv(2)=pizda(2,1)-pizda(1,2)
6874 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6875 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6877 eello6_graph3=-(s1+s2+s3+s4)
6879 eello6_graph3=-(s2+s3+s4)
6882 if (.not. calc_grad) return
6883 C Derivatives in gamma(k-1)
6884 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6885 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6886 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6887 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6888 C Derivatives in gamma(l-1)
6889 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6890 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6891 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6892 vv(1)=pizda(1,1)+pizda(2,2)
6893 vv(2)=pizda(2,1)-pizda(1,2)
6894 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6895 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6896 C Cartesian derivatives.
6902 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6904 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6907 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6909 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6910 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6912 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6913 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6915 vv(1)=pizda(1,1)+pizda(2,2)
6916 vv(2)=pizda(2,1)-pizda(1,2)
6917 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6919 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6921 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6924 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6926 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6928 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6934 c----------------------------------------------------------------------------
6935 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6936 implicit real*8 (a-h,o-z)
6937 include 'DIMENSIONS'
6938 include 'sizesclu.dat'
6939 include 'COMMON.IOUNITS'
6940 include 'COMMON.CHAIN'
6941 include 'COMMON.DERIV'
6942 include 'COMMON.INTERACT'
6943 include 'COMMON.CONTACTS'
6944 include 'COMMON.TORSION'
6945 include 'COMMON.VAR'
6946 include 'COMMON.GEO'
6947 include 'COMMON.FFIELD'
6948 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6949 & auxvec1(2),auxmat1(2,2)
6951 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6953 C Parallel Antiparallel C
6959 C \ j|/k\| \ |/k\|l C
6964 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6966 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6967 C energy moment and not to the cluster cumulant.
6968 cd write (2,*) 'eello_graph4: wturn6',wturn6
6969 iti=itortyp(itype(i))
6970 itj=itortyp(itype(j))
6971 c if (j.lt.nres-1) then
6972 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6973 itj1=itortyp(itype(j+1))
6977 itk=itortyp(itype(k))
6978 c if (k.lt.nres-1) then
6979 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6980 itk1=itortyp(itype(k+1))
6984 itl=itortyp(itype(l))
6985 if (l.lt.nres-1) then
6986 itl1=itortyp(itype(l+1))
6990 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6991 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6992 cd & ' itl',itl,' itl1',itl1
6995 s1=dip(3,jj,i)*dip(3,kk,k)
6997 s1=dip(2,jj,j)*dip(2,kk,l)
7000 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7001 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7003 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7004 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7006 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7007 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7009 call transpose2(EUg(1,1,k),auxmat(1,1))
7010 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7011 vv(1)=pizda(1,1)-pizda(2,2)
7012 vv(2)=pizda(2,1)+pizda(1,2)
7013 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7014 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7016 eello6_graph4=-(s1+s2+s3+s4)
7018 eello6_graph4=-(s2+s3+s4)
7020 if (.not. calc_grad) return
7021 C Derivatives in gamma(i-1)
7025 s1=dipderg(2,jj,i)*dip(3,kk,k)
7027 s1=dipderg(4,jj,j)*dip(2,kk,l)
7030 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7032 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7033 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7035 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7036 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7038 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7039 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7040 cd write (2,*) 'turn6 derivatives'
7042 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7044 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7048 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7050 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7054 C Derivatives in gamma(k-1)
7057 s1=dip(3,jj,i)*dipderg(2,kk,k)
7059 s1=dip(2,jj,j)*dipderg(4,kk,l)
7062 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7063 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7065 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7066 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7068 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7069 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7071 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7072 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7073 vv(1)=pizda(1,1)-pizda(2,2)
7074 vv(2)=pizda(2,1)+pizda(1,2)
7075 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7076 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7078 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7080 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7084 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7086 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7089 C Derivatives in gamma(j-1) or gamma(l-1)
7090 if (l.eq.j+1 .and. l.gt.1) then
7091 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7092 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7093 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7094 vv(1)=pizda(1,1)-pizda(2,2)
7095 vv(2)=pizda(2,1)+pizda(1,2)
7096 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7097 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7098 else if (j.gt.1) then
7099 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7100 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7101 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7102 vv(1)=pizda(1,1)-pizda(2,2)
7103 vv(2)=pizda(2,1)+pizda(1,2)
7104 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7105 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7106 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7108 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7111 C Cartesian derivatives.
7118 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7120 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7124 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7126 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7130 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7132 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7134 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7135 & b1(1,itj1),auxvec(1))
7136 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7138 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7139 & b1(1,itl1),auxvec(1))
7140 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7142 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7144 vv(1)=pizda(1,1)-pizda(2,2)
7145 vv(2)=pizda(2,1)+pizda(1,2)
7146 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7148 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7150 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7153 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7156 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7159 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7161 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7163 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7167 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7169 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7172 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7174 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7182 c----------------------------------------------------------------------------
7183 double precision function eello_turn6(i,jj,kk)
7184 implicit real*8 (a-h,o-z)
7185 include 'DIMENSIONS'
7186 include 'sizesclu.dat'
7187 include 'COMMON.IOUNITS'
7188 include 'COMMON.CHAIN'
7189 include 'COMMON.DERIV'
7190 include 'COMMON.INTERACT'
7191 include 'COMMON.CONTACTS'
7192 include 'COMMON.TORSION'
7193 include 'COMMON.VAR'
7194 include 'COMMON.GEO'
7195 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7196 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7198 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7199 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7200 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7201 C the respective energy moment and not to the cluster cumulant.
7206 iti=itortyp(itype(i))
7207 itk=itortyp(itype(k))
7208 itk1=itortyp(itype(k+1))
7209 itl=itortyp(itype(l))
7210 itj=itortyp(itype(j))
7211 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7212 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7213 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7218 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7220 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7224 derx_turn(lll,kkk,iii)=0.0d0
7231 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7233 cd write (2,*) 'eello6_5',eello6_5
7235 call transpose2(AEA(1,1,1),auxmat(1,1))
7236 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7237 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7238 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7242 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7243 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7244 s2 = scalar2(b1(1,itk),vtemp1(1))
7246 call transpose2(AEA(1,1,2),atemp(1,1))
7247 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7248 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7249 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7253 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7254 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7255 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7257 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7258 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7259 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7260 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7261 ss13 = scalar2(b1(1,itk),vtemp4(1))
7262 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7266 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7272 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7274 C Derivatives in gamma(i+2)
7276 call transpose2(AEA(1,1,1),auxmatd(1,1))
7277 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7278 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7279 call transpose2(AEAderg(1,1,2),atempd(1,1))
7280 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7281 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7285 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7286 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7287 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7293 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7294 C Derivatives in gamma(i+3)
7296 call transpose2(AEA(1,1,1),auxmatd(1,1))
7297 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7298 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7299 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7303 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7304 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7305 s2d = scalar2(b1(1,itk),vtemp1d(1))
7307 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7308 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7310 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7312 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7313 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7314 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7324 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7325 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7327 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7328 & -0.5d0*ekont*(s2d+s12d)
7330 C Derivatives in gamma(i+4)
7331 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7332 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7333 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7335 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7336 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7337 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7347 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7349 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7351 C Derivatives in gamma(i+5)
7353 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7354 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7355 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7359 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7360 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7361 s2d = scalar2(b1(1,itk),vtemp1d(1))
7363 call transpose2(AEA(1,1,2),atempd(1,1))
7364 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7365 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7369 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7370 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7372 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7373 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7374 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7384 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7385 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7387 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7388 & -0.5d0*ekont*(s2d+s12d)
7390 C Cartesian derivatives
7395 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7396 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7397 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7401 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7402 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7404 s2d = scalar2(b1(1,itk),vtemp1d(1))
7406 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7407 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7408 s8d = -(atempd(1,1)+atempd(2,2))*
7409 & scalar2(cc(1,1,itl),vtemp2(1))
7413 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7415 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7416 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7423 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7426 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7430 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7431 & - 0.5d0*(s8d+s12d)
7433 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7442 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7444 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7445 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7446 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7447 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7448 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7450 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7451 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7452 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7456 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7457 cd & 16*eel_turn6_num
7459 if (j.lt.nres-1) then
7466 if (l.lt.nres-1) then
7474 ggg1(ll)=eel_turn6*g_contij(ll,1)
7475 ggg2(ll)=eel_turn6*g_contij(ll,2)
7476 ghalf=0.5d0*ggg1(ll)
7478 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7479 & +ekont*derx_turn(ll,2,1)
7480 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7481 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7482 & +ekont*derx_turn(ll,4,1)
7483 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7484 ghalf=0.5d0*ggg2(ll)
7486 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7487 & +ekont*derx_turn(ll,2,2)
7488 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7489 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7490 & +ekont*derx_turn(ll,4,2)
7491 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7496 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7501 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7507 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7512 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7516 cd write (2,*) iii,g_corr6_loc(iii)
7519 eello_turn6=ekont*eel_turn6
7520 cd write (2,*) 'ekont',ekont
7521 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7524 crc-------------------------------------------------
7525 SUBROUTINE MATVEC2(A1,V1,V2)
7526 implicit real*8 (a-h,o-z)
7527 include 'DIMENSIONS'
7528 DIMENSION A1(2,2),V1(2),V2(2)
7532 c 3 VI=VI+A1(I,K)*V1(K)
7536 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7537 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7542 C---------------------------------------
7543 SUBROUTINE MATMAT2(A1,A2,A3)
7544 implicit real*8 (a-h,o-z)
7545 include 'DIMENSIONS'
7546 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7547 c DIMENSION AI3(2,2)
7551 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7557 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7558 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7559 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7560 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7568 c-------------------------------------------------------------------------
7569 double precision function scalar2(u,v)
7571 double precision u(2),v(2)
7574 scalar2=u(1)*v(1)+u(2)*v(2)
7578 C-----------------------------------------------------------------------------
7580 subroutine transpose2(a,at)
7582 double precision a(2,2),at(2,2)
7589 c--------------------------------------------------------------------------
7590 subroutine transpose(n,a,at)
7593 double precision a(n,n),at(n,n)
7601 C---------------------------------------------------------------------------
7602 subroutine prodmat3(a1,a2,kk,transp,prod)
7605 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7607 crc double precision auxmat(2,2),prod_(2,2)
7610 crc call transpose2(kk(1,1),auxmat(1,1))
7611 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7612 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7614 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7615 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7616 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7617 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7618 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7619 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7620 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7621 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7624 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7625 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7627 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7628 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7629 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7630 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7631 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7632 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7633 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7634 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7637 c call transpose2(a2(1,1),a2t(1,1))
7640 crc print *,((prod_(i,j),i=1,2),j=1,2)
7641 crc print *,((prod(i,j),i=1,2),j=1,2)
7645 C-----------------------------------------------------------------------------
7646 double precision function scalar(u,v)
7648 double precision u(3),v(3)