1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
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)
233 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
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 'DIMENSIONS.ZSCOPT'
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 'DIMENSIONS.ZSCOPT'
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.ENEPS'
361 include 'COMMON.SBRIDGE'
362 include 'COMMON.NAMES'
363 include 'COMMON.IOUNITS'
364 include 'COMMON.CONTACTS'
368 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
372 eneps_temp(j,i)=0.0d0
381 if (itypi.eq.ntyp1) cycle
382 itypi1=iabs(itype(i+1))
389 C Calculate SC interaction energy.
392 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
393 cd & 'iend=',iend(i,iint)
394 do j=istart(i,iint),iend(i,iint)
396 if (itypj.eq.ntyp1) cycle
400 C Change 12/1/95 to calculate four-body interactions
401 rij=xj*xj+yj*yj+zj*zj
403 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
404 eps0ij=eps(itypi,itypj)
406 e1=fac*fac*aa(itypi,itypj)
407 e2=fac*bb(itypi,itypj)
409 ij=icant(itypi,itypj)
411 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
412 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
415 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
416 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
417 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
418 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
419 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
420 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
421 if (bb(itypi,itypj).gt.0.0d0) then
428 C Calculate the components of the gradient in DC and X
430 fac=-rrij*(e1+evdwij)
435 gvdwx(k,i)=gvdwx(k,i)-gg(k)
436 gvdwx(k,j)=gvdwx(k,j)+gg(k)
440 gvdwc(l,k)=gvdwc(l,k)+gg(l)
445 C 12/1/95, revised on 5/20/97
447 C Calculate the contact function. The ith column of the array JCONT will
448 C contain the numbers of atoms that make contacts with the atom I (of numbers
449 C greater than I). The arrays FACONT and GACONT will contain the values of
450 C the contact function and its derivative.
452 C Uncomment next line, if the correlation interactions include EVDW explicitly.
453 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
454 C Uncomment next line, if the correlation interactions are contact function only
455 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
457 sigij=sigma(itypi,itypj)
458 r0ij=rs0(itypi,itypj)
460 C Check whether the SC's are not too far to make a contact.
463 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
464 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
466 if (fcont.gt.0.0D0) then
467 C If the SC-SC distance if close to sigma, apply spline.
468 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
469 cAdam & fcont1,fprimcont1)
470 cAdam fcont1=1.0d0-fcont1
471 cAdam if (fcont1.gt.0.0d0) then
472 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
473 cAdam fcont=fcont*fcont1
475 C Uncomment following 4 lines to have the geometric average of the epsilon0's
476 cga eps0ij=1.0d0/dsqrt(eps0ij)
478 cga gg(k)=gg(k)*eps0ij
480 cga eps0ij=-evdwij*eps0ij
481 C Uncomment for AL's type of SC correlation interactions.
483 num_conti=num_conti+1
485 facont(num_conti,i)=fcont*eps0ij
486 fprimcont=eps0ij*fprimcont/rij
488 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
489 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
490 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
491 C Uncomment following 3 lines for Skolnick's type of SC correlation.
492 gacont(1,num_conti,i)=-fprimcont*xj
493 gacont(2,num_conti,i)=-fprimcont*yj
494 gacont(3,num_conti,i)=-fprimcont*zj
495 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
496 cd write (iout,'(2i3,3f10.5)')
497 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
503 num_cont(i)=num_conti
508 gvdwc(j,i)=expon*gvdwc(j,i)
509 gvdwx(j,i)=expon*gvdwx(j,i)
513 C******************************************************************************
517 C To save time, the factor of EXPON has been extracted from ALL components
518 C of GVDWC and GRADX. Remember to multiply them by this factor before further
521 C******************************************************************************
524 C-----------------------------------------------------------------------------
525 subroutine eljk(evdw,evdw_t)
527 C This subroutine calculates the interaction energy of nonbonded side chains
528 C assuming the LJK potential of interaction.
530 implicit real*8 (a-h,o-z)
532 include 'DIMENSIONS.ZSCOPT'
533 include "DIMENSIONS.COMPAR"
536 include 'COMMON.LOCAL'
537 include 'COMMON.CHAIN'
538 include 'COMMON.DERIV'
539 include 'COMMON.INTERACT'
540 include 'COMMON.ENEPS'
541 include 'COMMON.IOUNITS'
542 include 'COMMON.NAMES'
547 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
550 eneps_temp(j,i)=0.0d0
557 if (itypi.eq.ntyp1) cycle
558 itypi1=iabs(itype(i+1))
563 C Calculate SC interaction energy.
566 do j=istart(i,iint),iend(i,iint)
568 if (itypj.eq.ntyp1) cycle
572 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
574 e_augm=augm(itypi,itypj)*fac_augm
577 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
578 fac=r_shift_inv**expon
579 e1=fac*fac*aa(itypi,itypj)
580 e2=fac*bb(itypi,itypj)
582 ij=icant(itypi,itypj)
583 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
584 & /dabs(eps(itypi,itypj))
585 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
586 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
587 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
588 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
589 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
590 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
591 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
592 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
593 if (bb(itypi,itypj).gt.0.0d0) then
600 C Calculate the components of the gradient in DC and X
602 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
607 gvdwx(k,i)=gvdwx(k,i)-gg(k)
608 gvdwx(k,j)=gvdwx(k,j)+gg(k)
612 gvdwc(l,k)=gvdwc(l,k)+gg(l)
622 gvdwc(j,i)=expon*gvdwc(j,i)
623 gvdwx(j,i)=expon*gvdwx(j,i)
629 C-----------------------------------------------------------------------------
630 subroutine ebp(evdw,evdw_t)
632 C This subroutine calculates the interaction energy of nonbonded side chains
633 C assuming the Berne-Pechukas potential of interaction.
635 implicit real*8 (a-h,o-z)
637 include 'DIMENSIONS.ZSCOPT'
638 include "DIMENSIONS.COMPAR"
641 include 'COMMON.LOCAL'
642 include 'COMMON.CHAIN'
643 include 'COMMON.DERIV'
644 include 'COMMON.NAMES'
645 include 'COMMON.INTERACT'
646 include 'COMMON.ENEPS'
647 include 'COMMON.IOUNITS'
648 include 'COMMON.CALC'
650 c double precision rrsave(maxdim)
656 eneps_temp(j,i)=0.0d0
661 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
662 c if (icall.eq.0) then
670 if (itypi.eq.ntyp1) cycle
671 itypi1=iabs(itype(i+1))
675 dxi=dc_norm(1,nres+i)
676 dyi=dc_norm(2,nres+i)
677 dzi=dc_norm(3,nres+i)
678 dsci_inv=vbld_inv(i+nres)
680 C Calculate SC interaction energy.
683 do j=istart(i,iint),iend(i,iint)
686 if (itypj.eq.ntyp1) cycle
687 dscj_inv=vbld_inv(j+nres)
688 chi1=chi(itypi,itypj)
689 chi2=chi(itypj,itypi)
696 alf12=0.5D0*(alf1+alf2)
697 C For diagnostics only!!!
710 dxj=dc_norm(1,nres+j)
711 dyj=dc_norm(2,nres+j)
712 dzj=dc_norm(3,nres+j)
713 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
714 cd if (icall.eq.0) then
720 C Calculate the angle-dependent terms of energy & contributions to derivatives.
722 C Calculate whole angle-dependent part of epsilon and contributions
724 fac=(rrij*sigsq)**expon2
725 e1=fac*fac*aa(itypi,itypj)
726 e2=fac*bb(itypi,itypj)
727 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
728 eps2der=evdwij*eps3rt
729 eps3der=evdwij*eps2rt
730 evdwij=evdwij*eps2rt*eps3rt
731 ij=icant(itypi,itypj)
732 aux=eps1*eps2rt**2*eps3rt**2
733 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
734 & /dabs(eps(itypi,itypj))
735 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
736 if (bb(itypi,itypj).gt.0.0d0) then
743 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
744 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
745 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
746 & restyp(itypi),i,restyp(itypj),j,
747 & epsi,sigm,chi1,chi2,chip1,chip2,
748 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
749 & om1,om2,om12,1.0D0/dsqrt(rrij),
752 C Calculate gradient components.
753 e1=e1*eps1*eps2rt**2*eps3rt**2
754 fac=-expon*(e1+evdwij)
757 C Calculate radial part of the gradient
761 C Calculate the angular part of the gradient and sum add the contributions
762 C to the appropriate components of the Cartesian gradient.
771 C-----------------------------------------------------------------------------
772 subroutine egb(evdw,evdw_t)
774 C This subroutine calculates the interaction energy of nonbonded side chains
775 C assuming the Gay-Berne potential of interaction.
777 implicit real*8 (a-h,o-z)
779 include 'DIMENSIONS.ZSCOPT'
780 include "DIMENSIONS.COMPAR"
783 include 'COMMON.LOCAL'
784 include 'COMMON.CHAIN'
785 include 'COMMON.DERIV'
786 include 'COMMON.NAMES'
787 include 'COMMON.INTERACT'
788 include 'COMMON.ENEPS'
789 include 'COMMON.IOUNITS'
790 include 'COMMON.CALC'
791 include 'COMMON.SBRIDGE'
798 eneps_temp(j,i)=0.0d0
801 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
805 c if (icall.gt.0) lprn=.true.
809 if (itypi.eq.ntyp1) cycle
810 itypi1=iabs(itype(i+1))
814 dxi=dc_norm(1,nres+i)
815 dyi=dc_norm(2,nres+i)
816 dzi=dc_norm(3,nres+i)
817 dsci_inv=vbld_inv(i+nres)
819 C Calculate SC interaction energy.
822 do j=istart(i,iint),iend(i,iint)
823 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
824 call dyn_ssbond_ene(i,j,evdwij)
826 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
827 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
828 C triple bond artifac removal
829 do k=j+1,iend(i,iint)
830 C search over all next residues
831 if (dyn_ss_mask(k)) then
832 C check if they are cysteins
833 C write(iout,*) 'k=',k
834 call triple_ssbond_ene(i,j,k,evdwij)
835 C call the energy function that removes the artifical triple disulfide
836 C bond the soubroutine is located in ssMD.F
838 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
839 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
845 if (itypj.eq.ntyp1) cycle
846 dscj_inv=vbld_inv(j+nres)
847 sig0ij=sigma(itypi,itypj)
848 chi1=chi(itypi,itypj)
849 chi2=chi(itypj,itypi)
856 alf12=0.5D0*(alf1+alf2)
857 C For diagnostics only!!!
870 dxj=dc_norm(1,nres+j)
871 dyj=dc_norm(2,nres+j)
872 dzj=dc_norm(3,nres+j)
873 c write (iout,*) i,j,xj,yj,zj
874 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
876 C Calculate angle-dependent terms of energy and contributions to their
880 sig=sig0ij*dsqrt(sigsq)
881 rij_shift=1.0D0/rij-sig+sig0ij
882 C I hate to put IF's in the loops, but here don't have another choice!!!!
883 if (rij_shift.le.0.0D0) then
888 c---------------------------------------------------------------
889 rij_shift=1.0D0/rij_shift
891 e1=fac*fac*aa(itypi,itypj)
892 e2=fac*bb(itypi,itypj)
893 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
894 eps2der=evdwij*eps3rt
895 eps3der=evdwij*eps2rt
896 evdwij=evdwij*eps2rt*eps3rt
897 if (bb(itypi,itypj).gt.0) then
902 ij=icant(itypi,itypj)
903 aux=eps1*eps2rt**2*eps3rt**2
904 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
905 & /dabs(eps(itypi,itypj))
906 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
907 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
908 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
909 c & aux*e2/eps(itypi,itypj)
911 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
912 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
914 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
915 & restyp(itypi),i,restyp(itypj),j,
916 & epsi,sigm,chi1,chi2,chip1,chip2,
917 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
918 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
920 write (iout,*) "partial sum", evdw, evdw_t
924 C Calculate gradient components.
925 e1=e1*eps1*eps2rt**2*eps3rt**2
926 fac=-expon*(e1+evdwij)*rij_shift
929 C Calculate the radial part of the gradient
933 C Calculate angular part of the gradient.
936 C write(iout,*) "partial sum", evdw, evdw_t
943 C-----------------------------------------------------------------------------
944 subroutine egbv(evdw,evdw_t)
946 C This subroutine calculates the interaction energy of nonbonded side chains
947 C assuming the Gay-Berne-Vorobjev potential of interaction.
949 implicit real*8 (a-h,o-z)
951 include 'DIMENSIONS.ZSCOPT'
952 include "DIMENSIONS.COMPAR"
955 include 'COMMON.LOCAL'
956 include 'COMMON.CHAIN'
957 include 'COMMON.DERIV'
958 include 'COMMON.NAMES'
959 include 'COMMON.INTERACT'
960 include 'COMMON.ENEPS'
961 include 'COMMON.IOUNITS'
962 include 'COMMON.CALC'
969 eneps_temp(j,i)=0.0d0
974 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
977 c if (icall.gt.0) lprn=.true.
981 if (itypi.eq.ntyp1) cycle
982 itypi1=iabs(itype(i+1))
986 dxi=dc_norm(1,nres+i)
987 dyi=dc_norm(2,nres+i)
988 dzi=dc_norm(3,nres+i)
989 dsci_inv=vbld_inv(i+nres)
991 C Calculate SC interaction energy.
994 do j=istart(i,iint),iend(i,iint)
997 if (itypj.eq.ntyp1) cycle
998 dscj_inv=vbld_inv(j+nres)
999 sig0ij=sigma(itypi,itypj)
1000 r0ij=r0(itypi,itypj)
1001 chi1=chi(itypi,itypj)
1002 chi2=chi(itypj,itypi)
1009 alf12=0.5D0*(alf1+alf2)
1010 C For diagnostics only!!!
1023 dxj=dc_norm(1,nres+j)
1024 dyj=dc_norm(2,nres+j)
1025 dzj=dc_norm(3,nres+j)
1026 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1028 C Calculate angle-dependent terms of energy and contributions to their
1032 sig=sig0ij*dsqrt(sigsq)
1033 rij_shift=1.0D0/rij-sig+r0ij
1034 C I hate to put IF's in the loops, but here don't have another choice!!!!
1035 if (rij_shift.le.0.0D0) then
1040 c---------------------------------------------------------------
1041 rij_shift=1.0D0/rij_shift
1042 fac=rij_shift**expon
1043 e1=fac*fac*aa(itypi,itypj)
1044 e2=fac*bb(itypi,itypj)
1045 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1046 eps2der=evdwij*eps3rt
1047 eps3der=evdwij*eps2rt
1048 fac_augm=rrij**expon
1049 e_augm=augm(itypi,itypj)*fac_augm
1050 evdwij=evdwij*eps2rt*eps3rt
1051 if (bb(itypi,itypj).gt.0.0d0) then
1052 evdw=evdw+evdwij+e_augm
1054 evdw_t=evdw_t+evdwij+e_augm
1056 ij=icant(itypi,itypj)
1057 aux=eps1*eps2rt**2*eps3rt**2
1058 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1059 & /dabs(eps(itypi,itypj))
1060 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1061 c eneps_temp(ij)=eneps_temp(ij)
1062 c & +(evdwij+e_augm)/eps(itypi,itypj)
1064 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1065 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1066 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1067 c & restyp(itypi),i,restyp(itypj),j,
1068 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1069 c & chi1,chi2,chip1,chip2,
1070 c & eps1,eps2rt**2,eps3rt**2,
1071 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1075 C Calculate gradient components.
1076 e1=e1*eps1*eps2rt**2*eps3rt**2
1077 fac=-expon*(e1+evdwij)*rij_shift
1079 fac=rij*fac-2*expon*rrij*e_augm
1080 C Calculate the radial part of the gradient
1084 C Calculate angular part of the gradient.
1092 C-----------------------------------------------------------------------------
1093 subroutine sc_angular
1094 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1095 C om12. Called by ebp, egb, and egbv.
1097 include 'COMMON.CALC'
1101 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1102 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1103 om12=dxi*dxj+dyi*dyj+dzi*dzj
1105 C Calculate eps1(om12) and its derivative in om12
1106 faceps1=1.0D0-om12*chiom12
1107 faceps1_inv=1.0D0/faceps1
1108 eps1=dsqrt(faceps1_inv)
1109 C Following variable is eps1*deps1/dom12
1110 eps1_om12=faceps1_inv*chiom12
1111 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1116 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1117 sigsq=1.0D0-facsig*faceps1_inv
1118 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1119 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1120 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1121 C Calculate eps2 and its derivatives in om1, om2, and om12.
1124 chipom12=chip12*om12
1125 facp=1.0D0-om12*chipom12
1127 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1128 C Following variable is the square root of eps2
1129 eps2rt=1.0D0-facp1*facp_inv
1130 C Following three variables are the derivatives of the square root of eps
1131 C in om1, om2, and om12.
1132 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1133 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1134 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1135 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1136 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1137 C Calculate whole angle-dependent part of epsilon and contributions
1138 C to its derivatives
1141 C----------------------------------------------------------------------------
1143 implicit real*8 (a-h,o-z)
1144 include 'DIMENSIONS'
1145 include 'DIMENSIONS.ZSCOPT'
1146 include 'COMMON.CHAIN'
1147 include 'COMMON.DERIV'
1148 include 'COMMON.CALC'
1149 double precision dcosom1(3),dcosom2(3)
1150 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1151 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1152 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1153 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1155 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1156 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1159 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1162 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1163 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1164 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1165 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1166 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1167 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1170 C Calculate the components of the gradient in DC and X
1174 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1179 c------------------------------------------------------------------------------
1180 subroutine vec_and_deriv
1181 implicit real*8 (a-h,o-z)
1182 include 'DIMENSIONS'
1183 include 'DIMENSIONS.ZSCOPT'
1184 include 'COMMON.IOUNITS'
1185 include 'COMMON.GEO'
1186 include 'COMMON.VAR'
1187 include 'COMMON.LOCAL'
1188 include 'COMMON.CHAIN'
1189 include 'COMMON.VECTORS'
1190 include 'COMMON.DERIV'
1191 include 'COMMON.INTERACT'
1192 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1193 C Compute the local reference systems. For reference system (i), the
1194 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1195 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1197 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1198 if (i.eq.nres-1) then
1199 C Case of the last full residue
1200 C Compute the Z-axis
1201 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1202 costh=dcos(pi-theta(nres))
1203 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1208 C Compute the derivatives of uz
1210 uzder(2,1,1)=-dc_norm(3,i-1)
1211 uzder(3,1,1)= dc_norm(2,i-1)
1212 uzder(1,2,1)= dc_norm(3,i-1)
1214 uzder(3,2,1)=-dc_norm(1,i-1)
1215 uzder(1,3,1)=-dc_norm(2,i-1)
1216 uzder(2,3,1)= dc_norm(1,i-1)
1219 uzder(2,1,2)= dc_norm(3,i)
1220 uzder(3,1,2)=-dc_norm(2,i)
1221 uzder(1,2,2)=-dc_norm(3,i)
1223 uzder(3,2,2)= dc_norm(1,i)
1224 uzder(1,3,2)= dc_norm(2,i)
1225 uzder(2,3,2)=-dc_norm(1,i)
1228 C Compute the Y-axis
1231 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1234 C Compute the derivatives of uy
1237 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1238 & -dc_norm(k,i)*dc_norm(j,i-1)
1239 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1241 uyder(j,j,1)=uyder(j,j,1)-costh
1242 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1247 uygrad(l,k,j,i)=uyder(l,k,j)
1248 uzgrad(l,k,j,i)=uzder(l,k,j)
1252 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1253 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1254 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1255 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1259 C Compute the Z-axis
1260 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1261 costh=dcos(pi-theta(i+2))
1262 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1267 C Compute the derivatives of uz
1269 uzder(2,1,1)=-dc_norm(3,i+1)
1270 uzder(3,1,1)= dc_norm(2,i+1)
1271 uzder(1,2,1)= dc_norm(3,i+1)
1273 uzder(3,2,1)=-dc_norm(1,i+1)
1274 uzder(1,3,1)=-dc_norm(2,i+1)
1275 uzder(2,3,1)= dc_norm(1,i+1)
1278 uzder(2,1,2)= dc_norm(3,i)
1279 uzder(3,1,2)=-dc_norm(2,i)
1280 uzder(1,2,2)=-dc_norm(3,i)
1282 uzder(3,2,2)= dc_norm(1,i)
1283 uzder(1,3,2)= dc_norm(2,i)
1284 uzder(2,3,2)=-dc_norm(1,i)
1287 C Compute the Y-axis
1290 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1293 C Compute the derivatives of uy
1296 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1297 & -dc_norm(k,i)*dc_norm(j,i+1)
1298 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1300 uyder(j,j,1)=uyder(j,j,1)-costh
1301 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1306 uygrad(l,k,j,i)=uyder(l,k,j)
1307 uzgrad(l,k,j,i)=uzder(l,k,j)
1311 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1312 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1313 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1314 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1320 vbld_inv_temp(1)=vbld_inv(i+1)
1321 if (i.lt.nres-1) then
1322 vbld_inv_temp(2)=vbld_inv(i+2)
1324 vbld_inv_temp(2)=vbld_inv(i)
1329 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1330 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1338 C-----------------------------------------------------------------------------
1339 subroutine vec_and_deriv_test
1340 implicit real*8 (a-h,o-z)
1341 include 'DIMENSIONS'
1342 include 'DIMENSIONS.ZSCOPT'
1343 include 'COMMON.IOUNITS'
1344 include 'COMMON.GEO'
1345 include 'COMMON.VAR'
1346 include 'COMMON.LOCAL'
1347 include 'COMMON.CHAIN'
1348 include 'COMMON.VECTORS'
1349 dimension uyder(3,3,2),uzder(3,3,2)
1350 C Compute the local reference systems. For reference system (i), the
1351 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1352 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1354 if (i.eq.nres-1) then
1355 C Case of the last full residue
1356 C Compute the Z-axis
1357 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1358 costh=dcos(pi-theta(nres))
1359 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1360 c write (iout,*) 'fac',fac,
1361 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1362 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1366 C Compute the derivatives of uz
1368 uzder(2,1,1)=-dc_norm(3,i-1)
1369 uzder(3,1,1)= dc_norm(2,i-1)
1370 uzder(1,2,1)= dc_norm(3,i-1)
1372 uzder(3,2,1)=-dc_norm(1,i-1)
1373 uzder(1,3,1)=-dc_norm(2,i-1)
1374 uzder(2,3,1)= dc_norm(1,i-1)
1377 uzder(2,1,2)= dc_norm(3,i)
1378 uzder(3,1,2)=-dc_norm(2,i)
1379 uzder(1,2,2)=-dc_norm(3,i)
1381 uzder(3,2,2)= dc_norm(1,i)
1382 uzder(1,3,2)= dc_norm(2,i)
1383 uzder(2,3,2)=-dc_norm(1,i)
1385 C Compute the Y-axis
1387 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1390 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1391 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1392 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1394 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1397 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1398 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1401 c write (iout,*) 'facy',facy,
1402 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1403 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1405 uy(k,i)=facy*uy(k,i)
1407 C Compute the derivatives of uy
1410 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1411 & -dc_norm(k,i)*dc_norm(j,i-1)
1412 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1414 c uyder(j,j,1)=uyder(j,j,1)-costh
1415 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1416 uyder(j,j,1)=uyder(j,j,1)
1417 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1418 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1424 uygrad(l,k,j,i)=uyder(l,k,j)
1425 uzgrad(l,k,j,i)=uzder(l,k,j)
1429 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1430 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1431 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1432 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1435 C Compute the Z-axis
1436 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1437 costh=dcos(pi-theta(i+2))
1438 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1439 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1443 C Compute the derivatives of uz
1445 uzder(2,1,1)=-dc_norm(3,i+1)
1446 uzder(3,1,1)= dc_norm(2,i+1)
1447 uzder(1,2,1)= dc_norm(3,i+1)
1449 uzder(3,2,1)=-dc_norm(1,i+1)
1450 uzder(1,3,1)=-dc_norm(2,i+1)
1451 uzder(2,3,1)= dc_norm(1,i+1)
1454 uzder(2,1,2)= dc_norm(3,i)
1455 uzder(3,1,2)=-dc_norm(2,i)
1456 uzder(1,2,2)=-dc_norm(3,i)
1458 uzder(3,2,2)= dc_norm(1,i)
1459 uzder(1,3,2)= dc_norm(2,i)
1460 uzder(2,3,2)=-dc_norm(1,i)
1462 C Compute the Y-axis
1464 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1465 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1466 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1468 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1471 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1472 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1475 c write (iout,*) 'facy',facy,
1476 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1477 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1479 uy(k,i)=facy*uy(k,i)
1481 C Compute the derivatives of uy
1484 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1485 & -dc_norm(k,i)*dc_norm(j,i+1)
1486 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1488 c uyder(j,j,1)=uyder(j,j,1)-costh
1489 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1490 uyder(j,j,1)=uyder(j,j,1)
1491 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1492 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1498 uygrad(l,k,j,i)=uyder(l,k,j)
1499 uzgrad(l,k,j,i)=uzder(l,k,j)
1503 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1504 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1505 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1506 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1513 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1514 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1521 C-----------------------------------------------------------------------------
1522 subroutine check_vecgrad
1523 implicit real*8 (a-h,o-z)
1524 include 'DIMENSIONS'
1525 include 'DIMENSIONS.ZSCOPT'
1526 include 'COMMON.IOUNITS'
1527 include 'COMMON.GEO'
1528 include 'COMMON.VAR'
1529 include 'COMMON.LOCAL'
1530 include 'COMMON.CHAIN'
1531 include 'COMMON.VECTORS'
1532 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1533 dimension uyt(3,maxres),uzt(3,maxres)
1534 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1535 double precision delta /1.0d-7/
1538 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1539 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1540 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1541 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1542 cd & (dc_norm(if90,i),if90=1,3)
1543 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1544 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1545 cd write(iout,'(a)')
1551 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1552 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1565 cd write (iout,*) 'i=',i
1567 erij(k)=dc_norm(k,i)
1571 dc_norm(k,i)=erij(k)
1573 dc_norm(j,i)=dc_norm(j,i)+delta
1574 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1576 c dc_norm(k,i)=dc_norm(k,i)/fac
1578 c write (iout,*) (dc_norm(k,i),k=1,3)
1579 c write (iout,*) (erij(k),k=1,3)
1582 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1583 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1584 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1585 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1587 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1588 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1589 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1592 dc_norm(k,i)=erij(k)
1595 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1596 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1597 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1598 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1599 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1600 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1601 cd write (iout,'(a)')
1606 C--------------------------------------------------------------------------
1607 subroutine set_matrices
1608 implicit real*8 (a-h,o-z)
1609 include 'DIMENSIONS'
1610 include 'DIMENSIONS.ZSCOPT'
1611 include 'COMMON.IOUNITS'
1612 include 'COMMON.GEO'
1613 include 'COMMON.VAR'
1614 include 'COMMON.LOCAL'
1615 include 'COMMON.CHAIN'
1616 include 'COMMON.DERIV'
1617 include 'COMMON.INTERACT'
1618 include 'COMMON.CONTACTS'
1619 include 'COMMON.TORSION'
1620 include 'COMMON.VECTORS'
1621 include 'COMMON.FFIELD'
1622 double precision auxvec(2),auxmat(2,2)
1624 C Compute the virtual-bond-torsional-angle dependent quantities needed
1625 C to calculate the el-loc multibody terms of various order.
1628 if (i .lt. nres+1) then
1665 if (i .gt. 3 .and. i .lt. nres+1) then
1666 obrot_der(1,i-2)=-sin1
1667 obrot_der(2,i-2)= cos1
1668 Ugder(1,1,i-2)= sin1
1669 Ugder(1,2,i-2)=-cos1
1670 Ugder(2,1,i-2)=-cos1
1671 Ugder(2,2,i-2)=-sin1
1674 obrot2_der(1,i-2)=-dwasin2
1675 obrot2_der(2,i-2)= dwacos2
1676 Ug2der(1,1,i-2)= dwasin2
1677 Ug2der(1,2,i-2)=-dwacos2
1678 Ug2der(2,1,i-2)=-dwacos2
1679 Ug2der(2,2,i-2)=-dwasin2
1681 obrot_der(1,i-2)=0.0d0
1682 obrot_der(2,i-2)=0.0d0
1683 Ugder(1,1,i-2)=0.0d0
1684 Ugder(1,2,i-2)=0.0d0
1685 Ugder(2,1,i-2)=0.0d0
1686 Ugder(2,2,i-2)=0.0d0
1687 obrot2_der(1,i-2)=0.0d0
1688 obrot2_der(2,i-2)=0.0d0
1689 Ug2der(1,1,i-2)=0.0d0
1690 Ug2der(1,2,i-2)=0.0d0
1691 Ug2der(2,1,i-2)=0.0d0
1692 Ug2der(2,2,i-2)=0.0d0
1694 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1695 if (itype(i-2).le.ntyp) then
1696 iti = itortyp(itype(i-2))
1703 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1704 if (itype(i-1).le.ntyp) then
1705 iti1 = itortyp(itype(i-1))
1712 cd write (iout,*) '*******i',i,' iti1',iti
1713 cd write (iout,*) 'b1',b1(:,iti)
1714 cd write (iout,*) 'b2',b2(:,iti)
1715 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1716 c print *,"itilde1 i iti iti1",i,iti,iti1
1717 if (i .gt. iatel_s+2) then
1718 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1719 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1720 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1721 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1722 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1723 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1724 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1734 DtUg2(l,k,i-2)=0.0d0
1738 c print *,"itilde2 i iti iti1",i,iti,iti1
1739 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1740 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1741 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1742 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1743 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1744 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1745 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1746 c print *,"itilde3 i iti iti1",i,iti,iti1
1748 muder(k,i-2)=Ub2der(k,i-2)
1750 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1751 if (itype(i-1).le.ntyp) then
1752 iti1 = itortyp(itype(i-1))
1760 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1762 C Vectors and matrices dependent on a single virtual-bond dihedral.
1763 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1764 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1765 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1766 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1767 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1768 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1769 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1770 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1771 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1772 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1773 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1775 C Matrices dependent on two consecutive virtual-bond dihedrals.
1776 C The order of matrices is from left to right.
1778 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1779 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1780 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1781 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1782 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1783 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1784 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1785 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1788 cd iti = itortyp(itype(i))
1791 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1792 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1797 C--------------------------------------------------------------------------
1798 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1800 C This subroutine calculates the average interaction energy and its gradient
1801 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1802 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1803 C The potential depends both on the distance of peptide-group centers and on
1804 C the orientation of the CA-CA virtual bonds.
1806 implicit real*8 (a-h,o-z)
1807 include 'DIMENSIONS'
1808 include 'DIMENSIONS.ZSCOPT'
1809 include 'COMMON.CONTROL'
1810 include 'COMMON.IOUNITS'
1811 include 'COMMON.GEO'
1812 include 'COMMON.VAR'
1813 include 'COMMON.LOCAL'
1814 include 'COMMON.CHAIN'
1815 include 'COMMON.DERIV'
1816 include 'COMMON.INTERACT'
1817 include 'COMMON.CONTACTS'
1818 include 'COMMON.TORSION'
1819 include 'COMMON.VECTORS'
1820 include 'COMMON.FFIELD'
1821 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1822 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1823 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1824 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1825 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1826 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1827 double precision scal_el /0.5d0/
1829 C 13-go grudnia roku pamietnego...
1830 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1831 & 0.0d0,1.0d0,0.0d0,
1832 & 0.0d0,0.0d0,1.0d0/
1833 cd write(iout,*) 'In EELEC'
1835 cd write(iout,*) 'Type',i
1836 cd write(iout,*) 'B1',B1(:,i)
1837 cd write(iout,*) 'B2',B2(:,i)
1838 cd write(iout,*) 'CC',CC(:,:,i)
1839 cd write(iout,*) 'DD',DD(:,:,i)
1840 cd write(iout,*) 'EE',EE(:,:,i)
1842 cd call check_vecgrad
1844 if (icheckgrad.eq.1) then
1846 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1848 dc_norm(k,i)=dc(k,i)*fac
1850 c write (iout,*) 'i',i,' fac',fac
1853 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1854 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1855 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1856 cd if (wel_loc.gt.0.0d0) then
1857 if (icheckgrad.eq.1) then
1858 call vec_and_deriv_test
1865 cd write (iout,*) 'i=',i
1867 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1870 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1871 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1884 cd print '(a)','Enter EELEC'
1885 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1887 gel_loc_loc(i)=0.0d0
1890 do i=iatel_s,iatel_e
1891 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1892 if (itel(i).eq.0) goto 1215
1896 dx_normi=dc_norm(1,i)
1897 dy_normi=dc_norm(2,i)
1898 dz_normi=dc_norm(3,i)
1899 xmedi=c(1,i)+0.5d0*dxi
1900 ymedi=c(2,i)+0.5d0*dyi
1901 zmedi=c(3,i)+0.5d0*dzi
1903 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1904 do j=ielstart(i),ielend(i)
1905 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1906 if (itel(j).eq.0) goto 1216
1910 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1911 aaa=app(iteli,itelj)
1912 bbb=bpp(iteli,itelj)
1913 C Diagnostics only!!!
1919 ael6i=ael6(iteli,itelj)
1920 ael3i=ael3(iteli,itelj)
1924 dx_normj=dc_norm(1,j)
1925 dy_normj=dc_norm(2,j)
1926 dz_normj=dc_norm(3,j)
1927 xj=c(1,j)+0.5D0*dxj-xmedi
1928 yj=c(2,j)+0.5D0*dyj-ymedi
1929 zj=c(3,j)+0.5D0*dzj-zmedi
1930 rij=xj*xj+yj*yj+zj*zj
1936 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1937 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1938 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1939 fac=cosa-3.0D0*cosb*cosg
1941 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1942 if (j.eq.i+2) ev1=scal_el*ev1
1947 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1950 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1951 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1952 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1955 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
1956 c &'evdw1',i,j,evdwij
1957 c &,iteli,itelj,aaa,evdw1
1959 c write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
1960 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1961 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1962 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1963 c & xmedi,ymedi,zmedi,xj,yj,zj
1965 C Calculate contributions to the Cartesian gradient.
1968 facvdw=-6*rrmij*(ev1+evdwij)
1969 facel=-3*rrmij*(el1+eesij)
1976 * Radial derivatives. First process both termini of the fragment (i,j)
1983 gelc(k,i)=gelc(k,i)+ghalf
1984 gelc(k,j)=gelc(k,j)+ghalf
1987 * Loop over residues i+1 thru j-1.
1991 gelc(l,k)=gelc(l,k)+ggg(l)
1999 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2000 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2003 * Loop over residues i+1 thru j-1.
2007 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2014 fac=-3*rrmij*(facvdw+facvdw+facel)
2020 * Radial derivatives. First process both termini of the fragment (i,j)
2027 gelc(k,i)=gelc(k,i)+ghalf
2028 gelc(k,j)=gelc(k,j)+ghalf
2031 * Loop over residues i+1 thru j-1.
2035 gelc(l,k)=gelc(l,k)+ggg(l)
2042 ecosa=2.0D0*fac3*fac1+fac4
2045 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2046 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2048 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2049 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2051 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2052 cd & (dcosg(k),k=1,3)
2054 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2058 gelc(k,i)=gelc(k,i)+ghalf
2059 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2060 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2061 gelc(k,j)=gelc(k,j)+ghalf
2062 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2063 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2067 gelc(l,k)=gelc(l,k)+ggg(l)
2072 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2073 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2074 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2076 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2077 C energy of a peptide unit is assumed in the form of a second-order
2078 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2079 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2080 C are computed for EVERY pair of non-contiguous peptide groups.
2082 if (j.lt.nres-1) then
2093 muij(kkk)=mu(k,i)*mu(l,j)
2096 cd write (iout,*) 'EELEC: i',i,' j',j
2097 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2098 cd write(iout,*) 'muij',muij
2099 ury=scalar(uy(1,i),erij)
2100 urz=scalar(uz(1,i),erij)
2101 vry=scalar(uy(1,j),erij)
2102 vrz=scalar(uz(1,j),erij)
2103 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2104 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2105 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2106 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2107 C For diagnostics only
2112 fac=dsqrt(-ael6i)*r3ij
2113 cd write (2,*) 'fac=',fac
2114 C For diagnostics only
2120 cd write (iout,'(4i5,4f10.5)')
2121 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2122 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2123 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2124 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2125 cd write (iout,'(4f10.5)')
2126 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2127 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2128 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2129 cd write (iout,'(2i3,9f10.5/)') i,j,
2130 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2132 C Derivatives of the elements of A in virtual-bond vectors
2133 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2140 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2141 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2142 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2143 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2144 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2145 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2146 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2147 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2148 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2149 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2150 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2151 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2161 C Compute radial contributions to the gradient
2183 C Add the contributions coming from er
2186 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2187 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2188 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2189 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2192 C Derivatives in DC(i)
2193 ghalf1=0.5d0*agg(k,1)
2194 ghalf2=0.5d0*agg(k,2)
2195 ghalf3=0.5d0*agg(k,3)
2196 ghalf4=0.5d0*agg(k,4)
2197 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2198 & -3.0d0*uryg(k,2)*vry)+ghalf1
2199 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2200 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2201 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2202 & -3.0d0*urzg(k,2)*vry)+ghalf3
2203 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2204 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2205 C Derivatives in DC(i+1)
2206 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2207 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2208 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2209 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2210 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2211 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2212 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2213 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2214 C Derivatives in DC(j)
2215 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2216 & -3.0d0*vryg(k,2)*ury)+ghalf1
2217 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2218 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2219 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2220 & -3.0d0*vryg(k,2)*urz)+ghalf3
2221 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2222 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2223 C Derivatives in DC(j+1) or DC(nres-1)
2224 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2225 & -3.0d0*vryg(k,3)*ury)
2226 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2227 & -3.0d0*vrzg(k,3)*ury)
2228 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2229 & -3.0d0*vryg(k,3)*urz)
2230 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2231 & -3.0d0*vrzg(k,3)*urz)
2236 C Derivatives in DC(i+1)
2237 cd aggi1(k,1)=agg(k,1)
2238 cd aggi1(k,2)=agg(k,2)
2239 cd aggi1(k,3)=agg(k,3)
2240 cd aggi1(k,4)=agg(k,4)
2241 C Derivatives in DC(j)
2246 C Derivatives in DC(j+1)
2251 if (j.eq.nres-1 .and. i.lt.j-2) then
2253 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2254 cd aggj1(k,l)=agg(k,l)
2260 C Check the loc-el terms by numerical integration
2270 aggi(k,l)=-aggi(k,l)
2271 aggi1(k,l)=-aggi1(k,l)
2272 aggj(k,l)=-aggj(k,l)
2273 aggj1(k,l)=-aggj1(k,l)
2276 if (j.lt.nres-1) then
2282 aggi(k,l)=-aggi(k,l)
2283 aggi1(k,l)=-aggi1(k,l)
2284 aggj(k,l)=-aggj(k,l)
2285 aggj1(k,l)=-aggj1(k,l)
2296 aggi(k,l)=-aggi(k,l)
2297 aggi1(k,l)=-aggi1(k,l)
2298 aggj(k,l)=-aggj(k,l)
2299 aggj1(k,l)=-aggj1(k,l)
2305 IF (wel_loc.gt.0.0d0) THEN
2306 C Contribution to the local-electrostatic energy coming from the i-j pair
2307 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2309 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2310 c write (iout,'(a6,2i5,0pf7.3)')
2311 c & 'eelloc',i,j,eel_loc_ij
2312 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2313 eel_loc=eel_loc+eel_loc_ij
2314 C Partial derivatives in virtual-bond dihedral angles gamma
2317 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2318 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2319 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2320 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2321 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2322 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2323 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2324 cd write(iout,*) 'agg ',agg
2325 cd write(iout,*) 'aggi ',aggi
2326 cd write(iout,*) 'aggi1',aggi1
2327 cd write(iout,*) 'aggj ',aggj
2328 cd write(iout,*) 'aggj1',aggj1
2330 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2332 ggg(l)=agg(l,1)*muij(1)+
2333 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2337 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2340 C Remaining derivatives of eello
2342 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2343 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2344 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2345 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2346 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2347 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2348 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2349 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2353 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2354 C Contributions from turns
2359 call eturn34(i,j,eello_turn3,eello_turn4)
2361 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2362 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2364 C Calculate the contact function. The ith column of the array JCONT will
2365 C contain the numbers of atoms that make contacts with the atom I (of numbers
2366 C greater than I). The arrays FACONT and GACONT will contain the values of
2367 C the contact function and its derivative.
2368 c r0ij=1.02D0*rpp(iteli,itelj)
2369 c r0ij=1.11D0*rpp(iteli,itelj)
2370 r0ij=2.20D0*rpp(iteli,itelj)
2371 c r0ij=1.55D0*rpp(iteli,itelj)
2372 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2373 if (fcont.gt.0.0D0) then
2374 num_conti=num_conti+1
2375 if (num_conti.gt.maxconts) then
2376 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2377 & ' will skip next contacts for this conf.'
2379 jcont_hb(num_conti,i)=j
2380 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2381 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2382 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2384 d_cont(num_conti,i)=rij
2385 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2386 C --- Electrostatic-interaction matrix ---
2387 a_chuj(1,1,num_conti,i)=a22
2388 a_chuj(1,2,num_conti,i)=a23
2389 a_chuj(2,1,num_conti,i)=a32
2390 a_chuj(2,2,num_conti,i)=a33
2391 C --- Gradient of rij
2393 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2396 c a_chuj(1,1,num_conti,i)=-0.61d0
2397 c a_chuj(1,2,num_conti,i)= 0.4d0
2398 c a_chuj(2,1,num_conti,i)= 0.65d0
2399 c a_chuj(2,2,num_conti,i)= 0.50d0
2400 c else if (i.eq.2) then
2401 c a_chuj(1,1,num_conti,i)= 0.0d0
2402 c a_chuj(1,2,num_conti,i)= 0.0d0
2403 c a_chuj(2,1,num_conti,i)= 0.0d0
2404 c a_chuj(2,2,num_conti,i)= 0.0d0
2406 C --- and its gradients
2407 cd write (iout,*) 'i',i,' j',j
2409 cd write (iout,*) 'iii 1 kkk',kkk
2410 cd write (iout,*) agg(kkk,:)
2413 cd write (iout,*) 'iii 2 kkk',kkk
2414 cd write (iout,*) aggi(kkk,:)
2417 cd write (iout,*) 'iii 3 kkk',kkk
2418 cd write (iout,*) aggi1(kkk,:)
2421 cd write (iout,*) 'iii 4 kkk',kkk
2422 cd write (iout,*) aggj(kkk,:)
2425 cd write (iout,*) 'iii 5 kkk',kkk
2426 cd write (iout,*) aggj1(kkk,:)
2433 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2434 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2435 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2436 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2437 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2439 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2445 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2446 C Calculate contact energies
2448 wij=cosa-3.0D0*cosb*cosg
2451 c fac3=dsqrt(-ael6i)/r0ij**3
2452 fac3=dsqrt(-ael6i)*r3ij
2453 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2454 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2456 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2457 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2458 C Diagnostics. Comment out or remove after debugging!
2459 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2460 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2461 c ees0m(num_conti,i)=0.0D0
2463 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2464 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2465 facont_hb(num_conti,i)=fcont
2467 C Angular derivatives of the contact function
2468 ees0pij1=fac3/ees0pij
2469 ees0mij1=fac3/ees0mij
2470 fac3p=-3.0D0*fac3*rrmij
2471 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2472 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2474 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2475 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2476 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2477 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2478 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2479 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2480 ecosap=ecosa1+ecosa2
2481 ecosbp=ecosb1+ecosb2
2482 ecosgp=ecosg1+ecosg2
2483 ecosam=ecosa1-ecosa2
2484 ecosbm=ecosb1-ecosb2
2485 ecosgm=ecosg1-ecosg2
2494 fprimcont=fprimcont/rij
2495 cd facont_hb(num_conti,i)=1.0D0
2496 C Following line is for diagnostics.
2499 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2500 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2503 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2504 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2506 gggp(1)=gggp(1)+ees0pijp*xj
2507 gggp(2)=gggp(2)+ees0pijp*yj
2508 gggp(3)=gggp(3)+ees0pijp*zj
2509 gggm(1)=gggm(1)+ees0mijp*xj
2510 gggm(2)=gggm(2)+ees0mijp*yj
2511 gggm(3)=gggm(3)+ees0mijp*zj
2512 C Derivatives due to the contact function
2513 gacont_hbr(1,num_conti,i)=fprimcont*xj
2514 gacont_hbr(2,num_conti,i)=fprimcont*yj
2515 gacont_hbr(3,num_conti,i)=fprimcont*zj
2517 ghalfp=0.5D0*gggp(k)
2518 ghalfm=0.5D0*gggm(k)
2519 gacontp_hb1(k,num_conti,i)=ghalfp
2520 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2521 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2522 gacontp_hb2(k,num_conti,i)=ghalfp
2523 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2524 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2525 gacontp_hb3(k,num_conti,i)=gggp(k)
2526 gacontm_hb1(k,num_conti,i)=ghalfm
2527 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2528 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2529 gacontm_hb2(k,num_conti,i)=ghalfm
2530 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2531 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2532 gacontm_hb3(k,num_conti,i)=gggm(k)
2535 C Diagnostics. Comment out or remove after debugging!
2537 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2538 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2539 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2540 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2541 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2542 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2545 endif ! num_conti.le.maxconts
2550 num_cont_hb(i)=num_conti
2554 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2555 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2557 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2558 ccc eel_loc=eel_loc+eello_turn3
2561 C-----------------------------------------------------------------------------
2562 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2563 C Third- and fourth-order contributions from turns
2564 implicit real*8 (a-h,o-z)
2565 include 'DIMENSIONS'
2566 include 'DIMENSIONS.ZSCOPT'
2567 include 'COMMON.IOUNITS'
2568 include 'COMMON.GEO'
2569 include 'COMMON.VAR'
2570 include 'COMMON.LOCAL'
2571 include 'COMMON.CHAIN'
2572 include 'COMMON.DERIV'
2573 include 'COMMON.INTERACT'
2574 include 'COMMON.CONTACTS'
2575 include 'COMMON.TORSION'
2576 include 'COMMON.VECTORS'
2577 include 'COMMON.FFIELD'
2579 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2580 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2581 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2582 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2583 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2584 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2586 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2588 C Third-order contributions
2595 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2596 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2597 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2598 call transpose2(auxmat(1,1),auxmat1(1,1))
2599 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2600 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2601 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2602 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2603 cd & ' eello_turn3_num',4*eello_turn3_num
2605 C Derivatives in gamma(i)
2606 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2607 call transpose2(auxmat2(1,1),pizda(1,1))
2608 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2609 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2610 C Derivatives in gamma(i+1)
2611 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2612 call transpose2(auxmat2(1,1),pizda(1,1))
2613 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2614 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2615 & +0.5d0*(pizda(1,1)+pizda(2,2))
2616 C Cartesian derivatives
2618 a_temp(1,1)=aggi(l,1)
2619 a_temp(1,2)=aggi(l,2)
2620 a_temp(2,1)=aggi(l,3)
2621 a_temp(2,2)=aggi(l,4)
2622 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2623 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2624 & +0.5d0*(pizda(1,1)+pizda(2,2))
2625 a_temp(1,1)=aggi1(l,1)
2626 a_temp(1,2)=aggi1(l,2)
2627 a_temp(2,1)=aggi1(l,3)
2628 a_temp(2,2)=aggi1(l,4)
2629 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2630 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2631 & +0.5d0*(pizda(1,1)+pizda(2,2))
2632 a_temp(1,1)=aggj(l,1)
2633 a_temp(1,2)=aggj(l,2)
2634 a_temp(2,1)=aggj(l,3)
2635 a_temp(2,2)=aggj(l,4)
2636 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2637 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2638 & +0.5d0*(pizda(1,1)+pizda(2,2))
2639 a_temp(1,1)=aggj1(l,1)
2640 a_temp(1,2)=aggj1(l,2)
2641 a_temp(2,1)=aggj1(l,3)
2642 a_temp(2,2)=aggj1(l,4)
2643 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2644 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2645 & +0.5d0*(pizda(1,1)+pizda(2,2))
2648 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2649 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2651 C Fourth-order contributions
2659 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2660 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2661 iti1=itortyp(itype(i+1))
2662 iti2=itortyp(itype(i+2))
2663 iti3=itortyp(itype(i+3))
2664 call transpose2(EUg(1,1,i+1),e1t(1,1))
2665 call transpose2(Eug(1,1,i+2),e2t(1,1))
2666 call transpose2(Eug(1,1,i+3),e3t(1,1))
2667 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2668 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2669 s1=scalar2(b1(1,iti2),auxvec(1))
2670 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2671 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2672 s2=scalar2(b1(1,iti1),auxvec(1))
2673 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2674 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2675 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2676 eello_turn4=eello_turn4-(s1+s2+s3)
2677 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2678 cd & ' eello_turn4_num',8*eello_turn4_num
2679 C Derivatives in gamma(i)
2681 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2682 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2683 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2684 s1=scalar2(b1(1,iti2),auxvec(1))
2685 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2686 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2687 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2688 C Derivatives in gamma(i+1)
2689 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2690 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2691 s2=scalar2(b1(1,iti1),auxvec(1))
2692 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2693 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2694 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2695 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2696 C Derivatives in gamma(i+2)
2697 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2698 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2699 s1=scalar2(b1(1,iti2),auxvec(1))
2700 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2701 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2702 s2=scalar2(b1(1,iti1),auxvec(1))
2703 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2704 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2705 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2706 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2707 C Cartesian derivatives
2708 C Derivatives of this turn contributions in DC(i+2)
2709 if (j.lt.nres-1) then
2711 a_temp(1,1)=agg(l,1)
2712 a_temp(1,2)=agg(l,2)
2713 a_temp(2,1)=agg(l,3)
2714 a_temp(2,2)=agg(l,4)
2715 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2716 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2717 s1=scalar2(b1(1,iti2),auxvec(1))
2718 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2719 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2720 s2=scalar2(b1(1,iti1),auxvec(1))
2721 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2722 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2723 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2725 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2728 C Remaining derivatives of this turn contribution
2730 a_temp(1,1)=aggi(l,1)
2731 a_temp(1,2)=aggi(l,2)
2732 a_temp(2,1)=aggi(l,3)
2733 a_temp(2,2)=aggi(l,4)
2734 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2735 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2736 s1=scalar2(b1(1,iti2),auxvec(1))
2737 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2738 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2739 s2=scalar2(b1(1,iti1),auxvec(1))
2740 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2741 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2742 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2743 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2744 a_temp(1,1)=aggi1(l,1)
2745 a_temp(1,2)=aggi1(l,2)
2746 a_temp(2,1)=aggi1(l,3)
2747 a_temp(2,2)=aggi1(l,4)
2748 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2749 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2750 s1=scalar2(b1(1,iti2),auxvec(1))
2751 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2752 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2753 s2=scalar2(b1(1,iti1),auxvec(1))
2754 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2755 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2756 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2757 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2758 a_temp(1,1)=aggj(l,1)
2759 a_temp(1,2)=aggj(l,2)
2760 a_temp(2,1)=aggj(l,3)
2761 a_temp(2,2)=aggj(l,4)
2762 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2763 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2764 s1=scalar2(b1(1,iti2),auxvec(1))
2765 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2766 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2767 s2=scalar2(b1(1,iti1),auxvec(1))
2768 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2769 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2770 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2771 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2772 a_temp(1,1)=aggj1(l,1)
2773 a_temp(1,2)=aggj1(l,2)
2774 a_temp(2,1)=aggj1(l,3)
2775 a_temp(2,2)=aggj1(l,4)
2776 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2777 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2778 s1=scalar2(b1(1,iti2),auxvec(1))
2779 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2780 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2781 s2=scalar2(b1(1,iti1),auxvec(1))
2782 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2783 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2784 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2785 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2791 C-----------------------------------------------------------------------------
2792 subroutine vecpr(u,v,w)
2793 implicit real*8(a-h,o-z)
2794 dimension u(3),v(3),w(3)
2795 w(1)=u(2)*v(3)-u(3)*v(2)
2796 w(2)=-u(1)*v(3)+u(3)*v(1)
2797 w(3)=u(1)*v(2)-u(2)*v(1)
2800 C-----------------------------------------------------------------------------
2801 subroutine unormderiv(u,ugrad,unorm,ungrad)
2802 C This subroutine computes the derivatives of a normalized vector u, given
2803 C the derivatives computed without normalization conditions, ugrad. Returns
2806 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2807 double precision vec(3)
2808 double precision scalar
2810 c write (2,*) 'ugrad',ugrad
2813 vec(i)=scalar(ugrad(1,i),u(1))
2815 c write (2,*) 'vec',vec
2818 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2821 c write (2,*) 'ungrad',ungrad
2824 C-----------------------------------------------------------------------------
2825 subroutine escp(evdw2,evdw2_14)
2827 C This subroutine calculates the excluded-volume interaction energy between
2828 C peptide-group centers and side chains and its gradient in virtual-bond and
2829 C side-chain vectors.
2831 implicit real*8 (a-h,o-z)
2832 include 'DIMENSIONS'
2833 include 'DIMENSIONS.ZSCOPT'
2834 include 'COMMON.GEO'
2835 include 'COMMON.VAR'
2836 include 'COMMON.LOCAL'
2837 include 'COMMON.CHAIN'
2838 include 'COMMON.DERIV'
2839 include 'COMMON.INTERACT'
2840 include 'COMMON.FFIELD'
2841 include 'COMMON.IOUNITS'
2845 cd print '(a)','Enter ESCP'
2846 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2847 c & ' scal14',scal14
2848 do i=iatscp_s,iatscp_e
2849 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2851 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2852 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2853 if (iteli.eq.0) goto 1225
2854 xi=0.5D0*(c(1,i)+c(1,i+1))
2855 yi=0.5D0*(c(2,i)+c(2,i+1))
2856 zi=0.5D0*(c(3,i)+c(3,i+1))
2858 do iint=1,nscp_gr(i)
2860 do j=iscpstart(i,iint),iscpend(i,iint)
2861 itypj=iabs(itype(j))
2862 if (itypj.eq.ntyp1) cycle
2863 C Uncomment following three lines for SC-p interactions
2867 C Uncomment following three lines for Ca-p interactions
2871 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2873 e1=fac*fac*aad(itypj,iteli)
2874 e2=fac*bad(itypj,iteli)
2875 if (iabs(j-i) .le. 2) then
2878 evdw2_14=evdw2_14+e1+e2
2881 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
2882 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
2883 c & bad(itypj,iteli)
2887 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2889 fac=-(evdwij+e1)*rrij
2894 cd write (iout,*) 'j<i'
2895 C Uncomment following three lines for SC-p interactions
2897 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2900 cd write (iout,*) 'j>i'
2903 C Uncomment following line for SC-p interactions
2904 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2908 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2912 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2913 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2916 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2926 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2927 gradx_scp(j,i)=expon*gradx_scp(j,i)
2930 C******************************************************************************
2934 C To save time the factor EXPON has been extracted from ALL components
2935 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2938 C******************************************************************************
2941 C--------------------------------------------------------------------------
2942 subroutine edis(ehpb)
2944 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2946 implicit real*8 (a-h,o-z)
2947 include 'DIMENSIONS'
2948 include 'DIMENSIONS.ZSCOPT'
2949 include 'COMMON.SBRIDGE'
2950 include 'COMMON.CHAIN'
2951 include 'COMMON.DERIV'
2952 include 'COMMON.VAR'
2953 include 'COMMON.INTERACT'
2954 include 'COMMON.CONTROL'
2955 include 'COMMON.IOUNITS'
2958 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2959 cd print *,'link_start=',link_start,' link_end=',link_end
2960 C write(iout,*) link_end, "link_end"
2961 if (link_end.eq.0) return
2962 do i=link_start,link_end
2963 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2964 C CA-CA distance used in regularization of structure.
2967 C iii and jjj point to the residues for which the distance is assigned.
2968 if (ii.gt.nres) then
2975 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2976 C distance and angle dependent SS bond potential.
2977 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2978 C & iabs(itype(jjj)).eq.1) then
2979 C write(iout,*) constr_dist,"const"
2980 if (.not.dyn_ss .and. i.le.nss) then
2981 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2982 & iabs(itype(jjj)).eq.1) then
2983 call ssbond_ene(iii,jjj,eij)
2986 else if (ii.gt.nres .and. jj.gt.nres) then
2987 c Restraints from contact prediction
2989 if (constr_dist.eq.11) then
2990 C ehpb=ehpb+fordepth(i)**4.0d0
2991 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2992 ehpb=ehpb+fordepth(i)**4.0d0
2993 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2994 fac=fordepth(i)**4.0d0
2995 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2996 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
2997 C & ehpb,fordepth(i),dd
2998 C write(iout,*) ehpb,"atu?"
3000 C fac=fordepth(i)**4.0d0
3001 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3003 if (dhpb1(i).gt.0.0d0) then
3004 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3005 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3006 c write (iout,*) "beta nmr",
3007 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3011 C Get the force constant corresponding to this distance.
3013 C Calculate the contribution to energy.
3014 ehpb=ehpb+waga*rdis*rdis
3015 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3017 C Evaluate gradient.
3020 endif !end dhpb1(i).gt.0
3021 endif !end const_dist=11
3023 ggg(j)=fac*(c(j,jj)-c(j,ii))
3026 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3027 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3030 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3031 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3034 C write(iout,*) "before"
3036 C write(iout,*) "after",dd
3037 if (constr_dist.eq.11) then
3038 ehpb=ehpb+fordepth(i)**4.0d0
3039 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3040 fac=fordepth(i)**4.0d0
3041 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3042 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3043 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3044 C print *,ehpb,"tu?"
3045 C write(iout,*) ehpb,"btu?",
3046 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3047 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3048 C & ehpb,fordepth(i),dd
3050 if (dhpb1(i).gt.0.0d0) then
3051 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3052 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3053 c write (iout,*) "alph nmr",
3054 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3057 C Get the force constant corresponding to this distance.
3059 C Calculate the contribution to energy.
3060 ehpb=ehpb+waga*rdis*rdis
3061 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3063 C Evaluate gradient.
3070 ggg(j)=fac*(c(j,jj)-c(j,ii))
3072 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3073 C If this is a SC-SC distance, we need to calculate the contributions to the
3074 C Cartesian gradient in the SC vectors (ghpbx).
3077 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3078 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3083 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3088 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3091 C--------------------------------------------------------------------------
3092 subroutine ssbond_ene(i,j,eij)
3094 C Calculate the distance and angle dependent SS-bond potential energy
3095 C using a free-energy function derived based on RHF/6-31G** ab initio
3096 C calculations of diethyl disulfide.
3098 C A. Liwo and U. Kozlowska, 11/24/03
3100 implicit real*8 (a-h,o-z)
3101 include 'DIMENSIONS'
3102 include 'DIMENSIONS.ZSCOPT'
3103 include 'COMMON.SBRIDGE'
3104 include 'COMMON.CHAIN'
3105 include 'COMMON.DERIV'
3106 include 'COMMON.LOCAL'
3107 include 'COMMON.INTERACT'
3108 include 'COMMON.VAR'
3109 include 'COMMON.IOUNITS'
3110 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3111 itypi=iabs(itype(i))
3115 dxi=dc_norm(1,nres+i)
3116 dyi=dc_norm(2,nres+i)
3117 dzi=dc_norm(3,nres+i)
3118 dsci_inv=dsc_inv(itypi)
3119 itypj=iabs(itype(j))
3120 dscj_inv=dsc_inv(itypj)
3124 dxj=dc_norm(1,nres+j)
3125 dyj=dc_norm(2,nres+j)
3126 dzj=dc_norm(3,nres+j)
3127 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3132 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3133 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3134 om12=dxi*dxj+dyi*dyj+dzi*dzj
3136 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3137 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3143 deltat12=om2-om1+2.0d0
3145 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3146 & +akct*deltad*deltat12
3147 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3148 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3149 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3150 c & " deltat12",deltat12," eij",eij
3151 ed=2*akcm*deltad+akct*deltat12
3153 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3154 eom1=-2*akth*deltat1-pom1-om2*pom2
3155 eom2= 2*akth*deltat2+pom1-om1*pom2
3158 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3161 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3162 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3163 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3164 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3167 C Calculate the components of the gradient in DC and X
3171 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3176 C--------------------------------------------------------------------------
3177 subroutine ebond(estr)
3179 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3181 implicit real*8 (a-h,o-z)
3182 include 'DIMENSIONS'
3183 include 'DIMENSIONS.ZSCOPT'
3184 include 'COMMON.LOCAL'
3185 include 'COMMON.GEO'
3186 include 'COMMON.INTERACT'
3187 include 'COMMON.DERIV'
3188 include 'COMMON.VAR'
3189 include 'COMMON.CHAIN'
3190 include 'COMMON.IOUNITS'
3191 include 'COMMON.NAMES'
3192 include 'COMMON.FFIELD'
3193 include 'COMMON.CONTROL'
3194 logical energy_dec /.false./
3195 double precision u(3),ud(3)
3198 c write (iout,*) "distchainmax",distchainmax
3200 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3201 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3203 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3204 & *dc(j,i-1)/vbld(i)
3206 if (energy_dec) write(iout,*)
3207 & "estr1",i,vbld(i),distchainmax,
3208 & gnmr1(vbld(i),-1.0d0,distchainmax)
3210 diff = vbld(i)-vbldp0
3211 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3214 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3219 estr=0.5d0*AKP*estr+estr1
3221 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3225 if (iti.ne.10 .and. iti.ne.ntyp1) then
3228 diff=vbld(i+nres)-vbldsc0(1,iti)
3229 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3230 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3231 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3233 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3237 diff=vbld(i+nres)-vbldsc0(j,iti)
3238 ud(j)=aksc(j,iti)*diff
3239 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3253 uprod2=uprod2*u(k)*u(k)
3257 usumsqder=usumsqder+ud(j)*uprod2
3259 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3260 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3261 estr=estr+uprod/usum
3263 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3271 C--------------------------------------------------------------------------
3272 subroutine ebend(etheta,ethetacnstr)
3274 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3275 C angles gamma and its derivatives in consecutive thetas and gammas.
3277 implicit real*8 (a-h,o-z)
3278 include 'DIMENSIONS'
3279 include 'DIMENSIONS.ZSCOPT'
3280 include 'COMMON.LOCAL'
3281 include 'COMMON.GEO'
3282 include 'COMMON.INTERACT'
3283 include 'COMMON.DERIV'
3284 include 'COMMON.VAR'
3285 include 'COMMON.CHAIN'
3286 include 'COMMON.IOUNITS'
3287 include 'COMMON.NAMES'
3288 include 'COMMON.FFIELD'
3289 include 'COMMON.TORCNSTR'
3290 common /calcthet/ term1,term2,termm,diffak,ratak,
3291 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3292 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3293 double precision y(2),z(2)
3295 c time11=dexp(-2*time)
3298 c write (iout,*) "nres",nres
3299 c write (*,'(a,i2)') 'EBEND ICG=',icg
3300 c write (iout,*) ithet_start,ithet_end
3301 do i=ithet_start,ithet_end
3302 if (itype(i-1).eq.ntyp1) cycle
3303 C Zero the energy function and its derivative at 0 or pi.
3304 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3306 ichir1=isign(1,itype(i-2))
3307 ichir2=isign(1,itype(i))
3308 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3309 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3310 if (itype(i-1).eq.10) then
3311 itype1=isign(10,itype(i-2))
3312 ichir11=isign(1,itype(i-2))
3313 ichir12=isign(1,itype(i-2))
3314 itype2=isign(10,itype(i))
3315 ichir21=isign(1,itype(i))
3316 ichir22=isign(1,itype(i))
3319 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3323 c call proc_proc(phii,icrc)
3324 if (icrc.eq.1) phii=150.0
3334 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3338 c call proc_proc(phii1,icrc)
3339 if (icrc.eq.1) phii1=150.0
3351 C Calculate the "mean" value of theta from the part of the distribution
3352 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3353 C In following comments this theta will be referred to as t_c.
3354 thet_pred_mean=0.0d0
3356 athetk=athet(k,it,ichir1,ichir2)
3357 bthetk=bthet(k,it,ichir1,ichir2)
3359 athetk=athet(k,itype1,ichir11,ichir12)
3360 bthetk=bthet(k,itype2,ichir21,ichir22)
3362 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3364 c write (iout,*) "thet_pred_mean",thet_pred_mean
3365 dthett=thet_pred_mean*ssd
3366 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3367 c write (iout,*) "thet_pred_mean",thet_pred_mean
3368 C Derivatives of the "mean" values in gamma1 and gamma2.
3369 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3370 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3371 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3372 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3374 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3375 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3376 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3377 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3379 if (theta(i).gt.pi-delta) then
3380 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3382 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3383 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3384 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3386 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3388 else if (theta(i).lt.delta) then
3389 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3390 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3391 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3393 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3394 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3397 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3400 etheta=etheta+ethetai
3401 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3402 c & rad2deg*phii,rad2deg*phii1,ethetai
3403 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3404 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3405 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3409 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
3410 do i=1,ntheta_constr
3411 itheta=itheta_constr(i)
3412 thetiii=theta(itheta)
3413 difi=pinorm(thetiii-theta_constr0(i))
3414 if (difi.gt.theta_drange(i)) then
3415 difi=difi-theta_drange(i)
3416 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3417 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3418 & +for_thet_constr(i)*difi**3
3419 else if (difi.lt.-drange(i)) then
3421 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3422 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3423 & +for_thet_constr(i)*difi**3
3427 C if (energy_dec) then
3428 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
3429 C & i,itheta,rad2deg*thetiii,
3430 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
3431 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
3432 C & gloc(itheta+nphi-2,icg)
3435 C Ufff.... We've done all this!!!
3438 C---------------------------------------------------------------------------
3439 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3441 implicit real*8 (a-h,o-z)
3442 include 'DIMENSIONS'
3443 include 'COMMON.LOCAL'
3444 include 'COMMON.IOUNITS'
3445 common /calcthet/ term1,term2,termm,diffak,ratak,
3446 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3447 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3448 C Calculate the contributions to both Gaussian lobes.
3449 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3450 C The "polynomial part" of the "standard deviation" of this part of
3454 sig=sig*thet_pred_mean+polthet(j,it)
3456 C Derivative of the "interior part" of the "standard deviation of the"
3457 C gamma-dependent Gaussian lobe in t_c.
3458 sigtc=3*polthet(3,it)
3460 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3463 C Set the parameters of both Gaussian lobes of the distribution.
3464 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3465 fac=sig*sig+sigc0(it)
3468 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3469 sigsqtc=-4.0D0*sigcsq*sigtc
3470 c print *,i,sig,sigtc,sigsqtc
3471 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3472 sigtc=-sigtc/(fac*fac)
3473 C Following variable is sigma(t_c)**(-2)
3474 sigcsq=sigcsq*sigcsq
3476 sig0inv=1.0D0/sig0i**2
3477 delthec=thetai-thet_pred_mean
3478 delthe0=thetai-theta0i
3479 term1=-0.5D0*sigcsq*delthec*delthec
3480 term2=-0.5D0*sig0inv*delthe0*delthe0
3481 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3482 C NaNs in taking the logarithm. We extract the largest exponent which is added
3483 C to the energy (this being the log of the distribution) at the end of energy
3484 C term evaluation for this virtual-bond angle.
3485 if (term1.gt.term2) then
3487 term2=dexp(term2-termm)
3491 term1=dexp(term1-termm)
3494 C The ratio between the gamma-independent and gamma-dependent lobes of
3495 C the distribution is a Gaussian function of thet_pred_mean too.
3496 diffak=gthet(2,it)-thet_pred_mean
3497 ratak=diffak/gthet(3,it)**2
3498 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3499 C Let's differentiate it in thet_pred_mean NOW.
3501 C Now put together the distribution terms to make complete distribution.
3502 termexp=term1+ak*term2
3503 termpre=sigc+ak*sig0i
3504 C Contribution of the bending energy from this theta is just the -log of
3505 C the sum of the contributions from the two lobes and the pre-exponential
3506 C factor. Simple enough, isn't it?
3507 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3508 C NOW the derivatives!!!
3509 C 6/6/97 Take into account the deformation.
3510 E_theta=(delthec*sigcsq*term1
3511 & +ak*delthe0*sig0inv*term2)/termexp
3512 E_tc=((sigtc+aktc*sig0i)/termpre
3513 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3514 & aktc*term2)/termexp)
3517 c-----------------------------------------------------------------------------
3518 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3519 implicit real*8 (a-h,o-z)
3520 include 'DIMENSIONS'
3521 include 'COMMON.LOCAL'
3522 include 'COMMON.IOUNITS'
3523 common /calcthet/ term1,term2,termm,diffak,ratak,
3524 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3525 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3526 delthec=thetai-thet_pred_mean
3527 delthe0=thetai-theta0i
3528 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3529 t3 = thetai-thet_pred_mean
3533 t14 = t12+t6*sigsqtc
3535 t21 = thetai-theta0i
3541 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3542 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3543 & *(-t12*t9-ak*sig0inv*t27)
3547 C--------------------------------------------------------------------------
3548 subroutine ebend(etheta,ethetacnstr)
3550 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3551 C angles gamma and its derivatives in consecutive thetas and gammas.
3552 C ab initio-derived potentials from
3553 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3555 implicit real*8 (a-h,o-z)
3556 include 'DIMENSIONS'
3557 include 'DIMENSIONS.ZSCOPT'
3558 include 'COMMON.LOCAL'
3559 include 'COMMON.GEO'
3560 include 'COMMON.INTERACT'
3561 include 'COMMON.DERIV'
3562 include 'COMMON.VAR'
3563 include 'COMMON.CHAIN'
3564 include 'COMMON.IOUNITS'
3565 include 'COMMON.NAMES'
3566 include 'COMMON.FFIELD'
3567 include 'COMMON.CONTROL'
3568 include 'COMMON.TORCNSTR'
3569 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3570 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3571 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3572 & sinph1ph2(maxdouble,maxdouble)
3573 logical lprn /.false./, lprn1 /.false./
3575 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3576 do i=ithet_start,ithet_end
3577 c if (itype(i-1).eq.ntyp1) cycle
3578 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3579 &(itype(i).eq.ntyp1)) cycle
3580 if (iabs(itype(i+1)).eq.20) iblock=2
3581 if (iabs(itype(i+1)).ne.20) iblock=1
3585 theti2=0.5d0*theta(i)
3586 ityp2=ithetyp((itype(i-1)))
3588 coskt(k)=dcos(k*theti2)
3589 sinkt(k)=dsin(k*theti2)
3591 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3594 if (phii.ne.phii) phii=150.0
3598 ityp1=ithetyp((itype(i-2)))
3600 cosph1(k)=dcos(k*phii)
3601 sinph1(k)=dsin(k*phii)
3607 ityp1=ithetyp((itype(i-2)))
3612 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3615 if (phii1.ne.phii1) phii1=150.0
3620 ityp3=ithetyp((itype(i)))
3622 cosph2(k)=dcos(k*phii1)
3623 sinph2(k)=dsin(k*phii1)
3628 ityp3=ithetyp((itype(i)))
3634 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3635 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3637 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3640 ccl=cosph1(l)*cosph2(k-l)
3641 ssl=sinph1(l)*sinph2(k-l)
3642 scl=sinph1(l)*cosph2(k-l)
3643 csl=cosph1(l)*sinph2(k-l)
3644 cosph1ph2(l,k)=ccl-ssl
3645 cosph1ph2(k,l)=ccl+ssl
3646 sinph1ph2(l,k)=scl+csl
3647 sinph1ph2(k,l)=scl-csl
3651 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3652 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3653 write (iout,*) "coskt and sinkt"
3655 write (iout,*) k,coskt(k),sinkt(k)
3659 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3660 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3663 & write (iout,*) "k",k,"
3664 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3665 & " ethetai",ethetai
3668 write (iout,*) "cosph and sinph"
3670 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3672 write (iout,*) "cosph1ph2 and sinph2ph2"
3675 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3676 & sinph1ph2(l,k),sinph1ph2(k,l)
3679 write(iout,*) "ethetai",ethetai
3683 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3684 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3685 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3686 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3687 ethetai=ethetai+sinkt(m)*aux
3688 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3689 dephii=dephii+k*sinkt(m)*(
3690 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3691 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3692 dephii1=dephii1+k*sinkt(m)*(
3693 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3694 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3696 & write (iout,*) "m",m," k",k," bbthet",
3697 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3698 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3699 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3700 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3704 & write(iout,*) "ethetai",ethetai
3708 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3709 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3710 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3711 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3712 ethetai=ethetai+sinkt(m)*aux
3713 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3714 dephii=dephii+l*sinkt(m)*(
3715 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3716 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3717 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3718 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3719 dephii1=dephii1+(k-l)*sinkt(m)*(
3720 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3721 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3722 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3723 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3725 write (iout,*) "m",m," k",k," l",l," ffthet",
3726 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3727 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3728 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3729 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3730 & " ethetai",ethetai
3731 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3732 & cosph1ph2(k,l)*sinkt(m),
3733 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3739 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3740 & i,theta(i)*rad2deg,phii*rad2deg,
3741 & phii1*rad2deg,ethetai
3742 etheta=etheta+ethetai
3743 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3744 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3745 c gloc(nphi+i-2,icg)=wang*dethetai
3746 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3750 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
3751 do i=1,ntheta_constr
3752 itheta=itheta_constr(i)
3753 thetiii=theta(itheta)
3754 difi=pinorm(thetiii-theta_constr0(i))
3755 if (difi.gt.theta_drange(i)) then
3756 difi=difi-theta_drange(i)
3757 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3758 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3759 & +for_thet_constr(i)*difi**3
3760 else if (difi.lt.-drange(i)) then
3762 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
3763 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
3764 & +for_thet_constr(i)*difi**3
3768 C if (energy_dec) then
3769 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
3770 C & i,itheta,rad2deg*thetiii,
3771 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
3772 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
3773 C & gloc(itheta+nphi-2,icg)
3780 c-----------------------------------------------------------------------------
3781 subroutine esc(escloc)
3782 C Calculate the local energy of a side chain and its derivatives in the
3783 C corresponding virtual-bond valence angles THETA and the spherical angles
3785 implicit real*8 (a-h,o-z)
3786 include 'DIMENSIONS'
3787 include 'DIMENSIONS.ZSCOPT'
3788 include 'COMMON.GEO'
3789 include 'COMMON.LOCAL'
3790 include 'COMMON.VAR'
3791 include 'COMMON.INTERACT'
3792 include 'COMMON.DERIV'
3793 include 'COMMON.CHAIN'
3794 include 'COMMON.IOUNITS'
3795 include 'COMMON.NAMES'
3796 include 'COMMON.FFIELD'
3797 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3798 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3799 common /sccalc/ time11,time12,time112,theti,it,nlobit
3802 c write (iout,'(a)') 'ESC'
3803 do i=loc_start,loc_end
3805 if (it.eq.ntyp1) cycle
3806 if (it.eq.10) goto 1
3807 nlobit=nlob(iabs(it))
3808 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3809 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3810 theti=theta(i+1)-pipol
3814 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3816 if (x(2).gt.pi-delta) then
3820 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3822 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3823 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3825 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3826 & ddersc0(1),dersc(1))
3827 call spline2(x(2),pi-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),pi-delta,delta,esclocbi0,esclocbi1,
3834 & dersc0(2),esclocbi,dersc02)
3835 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3837 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
3849 c write (iout,*) escloci
3850 else if (x(2).lt.delta) then
3854 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3856 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3857 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3859 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3860 & ddersc0(1),dersc(1))
3861 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3862 & ddersc0(3),dersc(3))
3864 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3866 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3867 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3868 & dersc0(2),esclocbi,dersc02)
3869 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3874 call splinthet(x(2),0.5d0*delta,ss,ssd)
3876 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3878 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3879 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3881 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3882 c write (iout,*) escloci
3884 call enesc(x,escloci,dersc,ddummy,.false.)
3887 escloc=escloc+escloci
3888 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3890 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3892 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3893 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3898 C---------------------------------------------------------------------------
3899 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3900 implicit real*8 (a-h,o-z)
3901 include 'DIMENSIONS'
3902 include 'COMMON.GEO'
3903 include 'COMMON.LOCAL'
3904 include 'COMMON.IOUNITS'
3905 common /sccalc/ time11,time12,time112,theti,it,nlobit
3906 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3907 double precision contr(maxlob,-1:1)
3909 c write (iout,*) 'it=',it,' nlobit=',nlobit
3913 if (mixed) ddersc(j)=0.0d0
3917 C Because of periodicity of the dependence of the SC energy in omega we have
3918 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3919 C To avoid underflows, first compute & store the exponents.
3927 z(k)=x(k)-censc(k,j,it)
3932 Axk=Axk+gaussc(l,k,j,it)*z(l)
3938 expfac=expfac+Ax(k,j,iii)*z(k)
3946 C As in the case of ebend, we want to avoid underflows in exponentiation and
3947 C subsequent NaNs and INFs in energy calculation.
3948 C Find the largest exponent
3952 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3956 cd print *,'it=',it,' emin=',emin
3958 C Compute the contribution to SC energy and derivatives
3962 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3963 cd print *,'j=',j,' expfac=',expfac
3964 escloc_i=escloc_i+expfac
3966 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3970 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3971 & +gaussc(k,2,j,it))*expfac
3978 dersc(1)=dersc(1)/cos(theti)**2
3979 ddersc(1)=ddersc(1)/cos(theti)**2
3982 escloci=-(dlog(escloc_i)-emin)
3984 dersc(j)=dersc(j)/escloc_i
3988 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3993 C------------------------------------------------------------------------------
3994 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3995 implicit real*8 (a-h,o-z)
3996 include 'DIMENSIONS'
3997 include 'COMMON.GEO'
3998 include 'COMMON.LOCAL'
3999 include 'COMMON.IOUNITS'
4000 common /sccalc/ time11,time12,time112,theti,it,nlobit
4001 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4002 double precision contr(maxlob)
4013 z(k)=x(k)-censc(k,j,it)
4019 Axk=Axk+gaussc(l,k,j,it)*z(l)
4025 expfac=expfac+Ax(k,j)*z(k)
4030 C As in the case of ebend, we want to avoid underflows in exponentiation and
4031 C subsequent NaNs and INFs in energy calculation.
4032 C Find the largest exponent
4035 if (emin.gt.contr(j)) emin=contr(j)
4039 C Compute the contribution to SC energy and derivatives
4043 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4044 escloc_i=escloc_i+expfac
4046 dersc(k)=dersc(k)+Ax(k,j)*expfac
4048 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4049 & +gaussc(1,2,j,it))*expfac
4053 dersc(1)=dersc(1)/cos(theti)**2
4054 dersc12=dersc12/cos(theti)**2
4055 escloci=-(dlog(escloc_i)-emin)
4057 dersc(j)=dersc(j)/escloc_i
4059 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4063 c----------------------------------------------------------------------------------
4064 subroutine esc(escloc)
4065 C Calculate the local energy of a side chain and its derivatives in the
4066 C corresponding virtual-bond valence angles THETA and the spherical angles
4067 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4068 C added by Urszula Kozlowska. 07/11/2007
4070 implicit real*8 (a-h,o-z)
4071 include 'DIMENSIONS'
4072 include 'DIMENSIONS.ZSCOPT'
4073 include 'COMMON.GEO'
4074 include 'COMMON.LOCAL'
4075 include 'COMMON.VAR'
4076 include 'COMMON.SCROT'
4077 include 'COMMON.INTERACT'
4078 include 'COMMON.DERIV'
4079 include 'COMMON.CHAIN'
4080 include 'COMMON.IOUNITS'
4081 include 'COMMON.NAMES'
4082 include 'COMMON.FFIELD'
4083 include 'COMMON.CONTROL'
4084 include 'COMMON.VECTORS'
4085 double precision x_prime(3),y_prime(3),z_prime(3)
4086 & , sumene,dsc_i,dp2_i,x(65),
4087 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4088 & de_dxx,de_dyy,de_dzz,de_dt
4089 double precision s1_t,s1_6_t,s2_t,s2_6_t
4091 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4092 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4093 & dt_dCi(3),dt_dCi1(3)
4094 common /sccalc/ time11,time12,time112,theti,it,nlobit
4097 do i=loc_start,loc_end
4098 if (itype(i).eq.ntyp1) cycle
4099 costtab(i+1) =dcos(theta(i+1))
4100 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4101 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4102 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4103 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4104 cosfac=dsqrt(cosfac2)
4105 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4106 sinfac=dsqrt(sinfac2)
4108 if (it.eq.10) goto 1
4110 C Compute the axes of tghe local cartesian coordinates system; store in
4111 c x_prime, y_prime and z_prime
4118 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4119 C & dc_norm(3,i+nres)
4121 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4122 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4125 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4128 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4129 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4130 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4131 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4132 c & " xy",scalar(x_prime(1),y_prime(1)),
4133 c & " xz",scalar(x_prime(1),z_prime(1)),
4134 c & " yy",scalar(y_prime(1),y_prime(1)),
4135 c & " yz",scalar(y_prime(1),z_prime(1)),
4136 c & " zz",scalar(z_prime(1),z_prime(1))
4138 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4139 C to local coordinate system. Store in xx, yy, zz.
4145 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4146 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4147 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4154 C Compute the energy of the ith side cbain
4156 c write (2,*) "xx",xx," yy",yy," zz",zz
4159 x(j) = sc_parmin(j,it)
4162 Cc diagnostics - remove later
4164 yy1 = dsin(alph(2))*dcos(omeg(2))
4165 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4166 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4167 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4169 C," --- ", xx_w,yy_w,zz_w
4172 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4173 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4175 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4176 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4178 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4179 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4180 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4181 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4182 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4184 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4185 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4186 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4187 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4188 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4190 dsc_i = 0.743d0+x(61)
4192 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4193 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4194 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4195 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4196 s1=(1+x(63))/(0.1d0 + dscp1)
4197 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4198 s2=(1+x(65))/(0.1d0 + dscp2)
4199 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4200 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4201 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4202 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4204 c & dscp1,dscp2,sumene
4205 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4206 escloc = escloc + sumene
4207 c write (2,*) "escloc",escloc
4208 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4210 if (.not. calc_grad) goto 1
4213 C This section to check the numerical derivatives of the energy of ith side
4214 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4215 C #define DEBUG in the code to turn it on.
4217 write (2,*) "sumene =",sumene
4221 write (2,*) xx,yy,zz
4222 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4223 de_dxx_num=(sumenep-sumene)/aincr
4225 write (2,*) "xx+ sumene from enesc=",sumenep
4228 write (2,*) xx,yy,zz
4229 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4230 de_dyy_num=(sumenep-sumene)/aincr
4232 write (2,*) "yy+ sumene from enesc=",sumenep
4235 write (2,*) xx,yy,zz
4236 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4237 de_dzz_num=(sumenep-sumene)/aincr
4239 write (2,*) "zz+ sumene from enesc=",sumenep
4240 costsave=cost2tab(i+1)
4241 sintsave=sint2tab(i+1)
4242 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4243 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4244 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4245 de_dt_num=(sumenep-sumene)/aincr
4246 write (2,*) " t+ sumene from enesc=",sumenep
4247 cost2tab(i+1)=costsave
4248 sint2tab(i+1)=sintsave
4249 C End of diagnostics section.
4252 C Compute the gradient of esc
4254 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4255 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4256 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4257 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4258 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4259 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4260 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4261 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4262 pom1=(sumene3*sint2tab(i+1)+sumene1)
4263 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4264 pom2=(sumene4*cost2tab(i+1)+sumene2)
4265 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4266 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4267 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4268 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4270 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4271 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4272 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4274 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4275 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4276 & +(pom1+pom2)*pom_dx
4278 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4281 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4282 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4283 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4285 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4286 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4287 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4288 & +x(59)*zz**2 +x(60)*xx*zz
4289 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4290 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4291 & +(pom1-pom2)*pom_dy
4293 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4296 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4297 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4298 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4299 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4300 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4301 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4302 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4303 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4305 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4308 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4309 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4310 & +pom1*pom_dt1+pom2*pom_dt2
4312 write(2,*), "de_dt = ", de_dt,de_dt_num
4316 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4317 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4318 cosfac2xx=cosfac2*xx
4319 sinfac2yy=sinfac2*yy
4321 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4323 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4325 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4326 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4327 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4328 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4329 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4330 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4331 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4332 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4333 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4334 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4338 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4339 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4340 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4341 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4344 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4345 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4346 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4348 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4349 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4353 dXX_Ctab(k,i)=dXX_Ci(k)
4354 dXX_C1tab(k,i)=dXX_Ci1(k)
4355 dYY_Ctab(k,i)=dYY_Ci(k)
4356 dYY_C1tab(k,i)=dYY_Ci1(k)
4357 dZZ_Ctab(k,i)=dZZ_Ci(k)
4358 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4359 dXX_XYZtab(k,i)=dXX_XYZ(k)
4360 dYY_XYZtab(k,i)=dYY_XYZ(k)
4361 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4365 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4366 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4367 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4368 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4369 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4371 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4372 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4373 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4374 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4375 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4376 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4377 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4378 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4380 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4381 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4383 C to check gradient call subroutine check_grad
4390 c------------------------------------------------------------------------------
4391 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4393 C This procedure calculates two-body contact function g(rij) and its derivative:
4396 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4399 C where x=(rij-r0ij)/delta
4401 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4404 double precision rij,r0ij,eps0ij,fcont,fprimcont
4405 double precision x,x2,x4,delta
4409 if (x.lt.-1.0D0) then
4412 else if (x.le.1.0D0) then
4415 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4416 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4423 c------------------------------------------------------------------------------
4424 subroutine splinthet(theti,delta,ss,ssder)
4425 implicit real*8 (a-h,o-z)
4426 include 'DIMENSIONS'
4427 include 'DIMENSIONS.ZSCOPT'
4428 include 'COMMON.VAR'
4429 include 'COMMON.GEO'
4432 if (theti.gt.pipol) then
4433 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4435 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4440 c------------------------------------------------------------------------------
4441 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4443 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4444 double precision ksi,ksi2,ksi3,a1,a2,a3
4445 a1=fprim0*delta/(f1-f0)
4451 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4452 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4455 c------------------------------------------------------------------------------
4456 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4458 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4459 double precision ksi,ksi2,ksi3,a1,a2,a3
4464 a2=3*(f1x-f0x)-2*fprim0x*delta
4465 a3=fprim0x*delta-2*(f1x-f0x)
4466 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4469 C-----------------------------------------------------------------------------
4471 C-----------------------------------------------------------------------------
4472 subroutine etor(etors,edihcnstr,fact)
4473 implicit real*8 (a-h,o-z)
4474 include 'DIMENSIONS'
4475 include 'DIMENSIONS.ZSCOPT'
4476 include 'COMMON.VAR'
4477 include 'COMMON.GEO'
4478 include 'COMMON.LOCAL'
4479 include 'COMMON.TORSION'
4480 include 'COMMON.INTERACT'
4481 include 'COMMON.DERIV'
4482 include 'COMMON.CHAIN'
4483 include 'COMMON.NAMES'
4484 include 'COMMON.IOUNITS'
4485 include 'COMMON.FFIELD'
4486 include 'COMMON.TORCNSTR'
4488 C Set lprn=.true. for debugging
4492 do i=iphi_start,iphi_end
4493 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4494 & .or. itype(i).eq.ntyp1) cycle
4495 itori=itortyp(itype(i-2))
4496 itori1=itortyp(itype(i-1))
4499 C Proline-Proline pair is a special case...
4500 if (itori.eq.3 .and. itori1.eq.3) then
4501 if (phii.gt.-dwapi3) then
4503 fac=1.0D0/(1.0D0-cosphi)
4504 etorsi=v1(1,3,3)*fac
4505 etorsi=etorsi+etorsi
4506 etors=etors+etorsi-v1(1,3,3)
4507 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4510 v1ij=v1(j+1,itori,itori1)
4511 v2ij=v2(j+1,itori,itori1)
4514 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4515 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4519 v1ij=v1(j,itori,itori1)
4520 v2ij=v2(j,itori,itori1)
4523 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4524 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4528 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4529 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4530 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4531 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4532 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4534 ! 6/20/98 - dihedral angle constraints
4537 itori=idih_constr(i)
4540 if (difi.gt.drange(i)) then
4542 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4543 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4544 else if (difi.lt.-drange(i)) then
4546 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4547 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4549 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
4550 C & i,itori,rad2deg*phii,
4551 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
4553 ! write (iout,*) 'edihcnstr',edihcnstr
4556 c------------------------------------------------------------------------------
4558 subroutine etor(etors,edihcnstr,fact)
4559 implicit real*8 (a-h,o-z)
4560 include 'DIMENSIONS'
4561 include 'DIMENSIONS.ZSCOPT'
4562 include 'COMMON.VAR'
4563 include 'COMMON.GEO'
4564 include 'COMMON.LOCAL'
4565 include 'COMMON.TORSION'
4566 include 'COMMON.INTERACT'
4567 include 'COMMON.DERIV'
4568 include 'COMMON.CHAIN'
4569 include 'COMMON.NAMES'
4570 include 'COMMON.IOUNITS'
4571 include 'COMMON.FFIELD'
4572 include 'COMMON.TORCNSTR'
4574 C Set lprn=.true. for debugging
4578 do i=iphi_start,iphi_end
4579 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4580 & .or. itype(i).eq.ntyp1) cycle
4581 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4582 if (iabs(itype(i)).eq.20) then
4587 itori=itortyp(itype(i-2))
4588 itori1=itortyp(itype(i-1))
4591 C Regular cosine and sine terms
4592 do j=1,nterm(itori,itori1,iblock)
4593 v1ij=v1(j,itori,itori1,iblock)
4594 v2ij=v2(j,itori,itori1,iblock)
4597 etors=etors+v1ij*cosphi+v2ij*sinphi
4598 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4602 C E = SUM ----------------------------------- - v1
4603 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4605 cosphi=dcos(0.5d0*phii)
4606 sinphi=dsin(0.5d0*phii)
4607 do j=1,nlor(itori,itori1,iblock)
4608 vl1ij=vlor1(j,itori,itori1)
4609 vl2ij=vlor2(j,itori,itori1)
4610 vl3ij=vlor3(j,itori,itori1)
4611 pom=vl2ij*cosphi+vl3ij*sinphi
4612 pom1=1.0d0/(pom*pom+1.0d0)
4613 etors=etors+vl1ij*pom1
4614 c if (energy_dec) etors_ii=etors_ii+
4617 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4619 C Subtract the constant term
4620 etors=etors-v0(itori,itori1,iblock)
4622 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4623 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4624 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4625 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4626 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4629 ! 6/20/98 - dihedral angle constraints
4632 itori=idih_constr(i)
4634 difi=pinorm(phii-phi0(i))
4636 if (difi.gt.drange(i)) then
4638 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4639 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4640 edihi=0.25d0*ftors(i)*difi**4
4641 else if (difi.lt.-drange(i)) then
4643 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
4644 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
4645 edihi=0.25d0*ftors(i)*difi**4
4649 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
4650 & i,itori,rad2deg*phii,
4651 & rad2deg*difi,0.25d0*ftors(i)*difi**4
4652 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4654 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4655 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
4657 ! write (iout,*) 'edihcnstr',edihcnstr
4660 c----------------------------------------------------------------------------
4661 subroutine etor_d(etors_d,fact2)
4662 C 6/23/01 Compute double torsional energy
4663 implicit real*8 (a-h,o-z)
4664 include 'DIMENSIONS'
4665 include 'DIMENSIONS.ZSCOPT'
4666 include 'COMMON.VAR'
4667 include 'COMMON.GEO'
4668 include 'COMMON.LOCAL'
4669 include 'COMMON.TORSION'
4670 include 'COMMON.INTERACT'
4671 include 'COMMON.DERIV'
4672 include 'COMMON.CHAIN'
4673 include 'COMMON.NAMES'
4674 include 'COMMON.IOUNITS'
4675 include 'COMMON.FFIELD'
4676 include 'COMMON.TORCNSTR'
4678 C Set lprn=.true. for debugging
4682 do i=iphi_start,iphi_end-1
4683 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4684 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4685 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4687 itori=itortyp(itype(i-2))
4688 itori1=itortyp(itype(i-1))
4689 itori2=itortyp(itype(i))
4695 if (iabs(itype(i+1)).eq.20) iblock=2
4696 C Regular cosine and sine terms
4697 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4698 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4699 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4700 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4701 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4702 cosphi1=dcos(j*phii)
4703 sinphi1=dsin(j*phii)
4704 cosphi2=dcos(j*phii1)
4705 sinphi2=dsin(j*phii1)
4706 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4707 & v2cij*cosphi2+v2sij*sinphi2
4708 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4709 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4711 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4713 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4714 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4715 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4716 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4717 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4718 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4719 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4720 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4721 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4722 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4723 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4724 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4725 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4726 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4729 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4730 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4736 c------------------------------------------------------------------------------
4737 subroutine eback_sc_corr(esccor)
4738 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4739 c conformational states; temporarily implemented as differences
4740 c between UNRES torsional potentials (dependent on three types of
4741 c residues) and the torsional potentials dependent on all 20 types
4742 c of residues computed from AM1 energy surfaces of terminally-blocked
4743 c amino-acid residues.
4744 implicit real*8 (a-h,o-z)
4745 include 'DIMENSIONS'
4746 include 'DIMENSIONS.ZSCOPT'
4747 include 'COMMON.VAR'
4748 include 'COMMON.GEO'
4749 include 'COMMON.LOCAL'
4750 include 'COMMON.TORSION'
4751 include 'COMMON.SCCOR'
4752 include 'COMMON.INTERACT'
4753 include 'COMMON.DERIV'
4754 include 'COMMON.CHAIN'
4755 include 'COMMON.NAMES'
4756 include 'COMMON.IOUNITS'
4757 include 'COMMON.FFIELD'
4758 include 'COMMON.CONTROL'
4760 C Set lprn=.true. for debugging
4763 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4765 do i=itau_start,itau_end
4766 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4768 isccori=isccortyp(itype(i-2))
4769 isccori1=isccortyp(itype(i-1))
4771 do intertyp=1,3 !intertyp
4772 cc Added 09 May 2012 (Adasko)
4773 cc Intertyp means interaction type of backbone mainchain correlation:
4774 c 1 = SC...Ca...Ca...Ca
4775 c 2 = Ca...Ca...Ca...SC
4776 c 3 = SC...Ca...Ca...SCi
4778 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4779 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4780 & (itype(i-1).eq.ntyp1)))
4781 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4782 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4783 & .or.(itype(i).eq.ntyp1)))
4784 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4785 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4786 & (itype(i-3).eq.ntyp1)))) cycle
4787 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4788 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4790 do j=1,nterm_sccor(isccori,isccori1)
4791 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4792 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4793 cosphi=dcos(j*tauangle(intertyp,i))
4794 sinphi=dsin(j*tauangle(intertyp,i))
4795 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4796 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4798 C write (iout,*)"EBACK_SC_COR",esccor,i
4799 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4800 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4801 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4803 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4804 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4805 & (v1sccor(j,1,itori,itori1),j=1,6)
4806 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4807 c gsccor_loc(i-3)=gloci
4812 c------------------------------------------------------------------------------
4813 subroutine multibody(ecorr)
4814 C This subroutine calculates multi-body contributions to energy following
4815 C the idea of Skolnick et al. If side chains I and J make a contact and
4816 C at the same time side chains I+1 and J+1 make a contact, an extra
4817 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4818 implicit real*8 (a-h,o-z)
4819 include 'DIMENSIONS'
4820 include 'COMMON.IOUNITS'
4821 include 'COMMON.DERIV'
4822 include 'COMMON.INTERACT'
4823 include 'COMMON.CONTACTS'
4824 double precision gx(3),gx1(3)
4827 C Set lprn=.true. for debugging
4831 write (iout,'(a)') 'Contact function values:'
4833 write (iout,'(i2,20(1x,i2,f10.5))')
4834 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4849 num_conti=num_cont(i)
4850 num_conti1=num_cont(i1)
4855 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4856 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4857 cd & ' ishift=',ishift
4858 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4859 C The system gains extra energy.
4860 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4861 endif ! j1==j+-ishift
4870 c------------------------------------------------------------------------------
4871 double precision function esccorr(i,j,k,l,jj,kk)
4872 implicit real*8 (a-h,o-z)
4873 include 'DIMENSIONS'
4874 include 'COMMON.IOUNITS'
4875 include 'COMMON.DERIV'
4876 include 'COMMON.INTERACT'
4877 include 'COMMON.CONTACTS'
4878 double precision gx(3),gx1(3)
4883 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4884 C Calculate the multi-body contribution to energy.
4885 C Calculate multi-body contributions to the gradient.
4886 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4887 cd & k,l,(gacont(m,kk,k),m=1,3)
4889 gx(m) =ekl*gacont(m,jj,i)
4890 gx1(m)=eij*gacont(m,kk,k)
4891 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4892 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4893 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4894 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4898 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4903 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4909 c------------------------------------------------------------------------------
4911 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4912 implicit real*8 (a-h,o-z)
4913 include 'DIMENSIONS'
4914 integer dimen1,dimen2,atom,indx
4915 double precision buffer(dimen1,dimen2)
4916 double precision zapas
4917 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4918 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4919 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4920 num_kont=num_cont_hb(atom)
4924 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4927 buffer(i,indx+22)=facont_hb(i,atom)
4928 buffer(i,indx+23)=ees0p(i,atom)
4929 buffer(i,indx+24)=ees0m(i,atom)
4930 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4932 buffer(1,indx+26)=dfloat(num_kont)
4935 c------------------------------------------------------------------------------
4936 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4937 implicit real*8 (a-h,o-z)
4938 include 'DIMENSIONS'
4939 integer dimen1,dimen2,atom,indx
4940 double precision buffer(dimen1,dimen2)
4941 double precision zapas
4942 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4943 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
4944 & ees0m(ntyp,maxres),
4945 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4946 num_kont=buffer(1,indx+26)
4947 num_kont_old=num_cont_hb(atom)
4948 num_cont_hb(atom)=num_kont+num_kont_old
4953 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4956 facont_hb(ii,atom)=buffer(i,indx+22)
4957 ees0p(ii,atom)=buffer(i,indx+23)
4958 ees0m(ii,atom)=buffer(i,indx+24)
4959 jcont_hb(ii,atom)=buffer(i,indx+25)
4963 c------------------------------------------------------------------------------
4965 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4966 C This subroutine calculates multi-body contributions to hydrogen-bonding
4967 implicit real*8 (a-h,o-z)
4968 include 'DIMENSIONS'
4969 include 'DIMENSIONS.ZSCOPT'
4970 include 'COMMON.IOUNITS'
4972 include 'COMMON.INFO'
4974 include 'COMMON.FFIELD'
4975 include 'COMMON.DERIV'
4976 include 'COMMON.INTERACT'
4977 include 'COMMON.CONTACTS'
4979 parameter (max_cont=maxconts)
4980 parameter (max_dim=2*(8*3+2))
4981 parameter (msglen1=max_cont*max_dim*4)
4982 parameter (msglen2=2*msglen1)
4983 integer source,CorrelType,CorrelID,Error
4984 double precision buffer(max_cont,max_dim)
4986 double precision gx(3),gx1(3)
4989 C Set lprn=.true. for debugging
4994 if (fgProcs.le.1) goto 30
4996 write (iout,'(a)') 'Contact function values:'
4998 write (iout,'(2i3,50(1x,i2,f5.2))')
4999 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5000 & j=1,num_cont_hb(i))
5003 C Caution! Following code assumes that electrostatic interactions concerning
5004 C a given atom are split among at most two processors!
5014 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5017 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5018 if (MyRank.gt.0) then
5019 C Send correlation contributions to the preceding processor
5021 nn=num_cont_hb(iatel_s)
5022 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5023 cd write (iout,*) 'The BUFFER array:'
5025 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5027 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5029 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5030 C Clear the contacts of the atom passed to the neighboring processor
5031 nn=num_cont_hb(iatel_s+1)
5033 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5035 num_cont_hb(iatel_s)=0
5037 cd write (iout,*) 'Processor ',MyID,MyRank,
5038 cd & ' is sending correlation contribution to processor',MyID-1,
5039 cd & ' msglen=',msglen
5040 cd write (*,*) 'Processor ',MyID,MyRank,
5041 cd & ' is sending correlation contribution to processor',MyID-1,
5042 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5043 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5044 cd write (iout,*) 'Processor ',MyID,
5045 cd & ' has sent correlation contribution to processor',MyID-1,
5046 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5047 cd write (*,*) 'Processor ',MyID,
5048 cd & ' has sent correlation contribution to processor',MyID-1,
5049 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5051 endif ! (MyRank.gt.0)
5055 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5056 if (MyRank.lt.fgProcs-1) then
5057 C Receive correlation contributions from the next processor
5059 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5060 cd write (iout,*) 'Processor',MyID,
5061 cd & ' is receiving correlation contribution from processor',MyID+1,
5062 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5063 cd write (*,*) 'Processor',MyID,
5064 cd & ' is receiving correlation contribution from processor',MyID+1,
5065 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5067 do while (nbytes.le.0)
5068 call mp_probe(MyID+1,CorrelType,nbytes)
5070 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5071 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5072 cd write (iout,*) 'Processor',MyID,
5073 cd & ' has received correlation contribution from processor',MyID+1,
5074 cd & ' msglen=',msglen,' nbytes=',nbytes
5075 cd write (iout,*) 'The received BUFFER array:'
5077 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5079 if (msglen.eq.msglen1) then
5080 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5081 else if (msglen.eq.msglen2) then
5082 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5083 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5086 & 'ERROR!!!! message length changed while processing correlations.'
5088 & 'ERROR!!!! message length changed while processing correlations.'
5089 call mp_stopall(Error)
5090 endif ! msglen.eq.msglen1
5091 endif ! MyRank.lt.fgProcs-1
5098 write (iout,'(a)') 'Contact function values:'
5100 write (iout,'(2i3,50(1x,i2,f5.2))')
5101 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5102 & j=1,num_cont_hb(i))
5106 C Remove the loop below after debugging !!!
5113 C Calculate the local-electrostatic correlation terms
5114 do i=iatel_s,iatel_e+1
5116 num_conti=num_cont_hb(i)
5117 num_conti1=num_cont_hb(i+1)
5122 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5123 c & ' jj=',jj,' kk=',kk
5124 if (j1.eq.j+1 .or. j1.eq.j-1) then
5125 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5126 C The system gains extra energy.
5127 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5129 else if (j1.eq.j) then
5130 C Contacts I-J and I-(J+1) occur simultaneously.
5131 C The system loses extra energy.
5132 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5137 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5138 c & ' jj=',jj,' kk=',kk
5140 C Contacts I-J and (I+1)-J occur simultaneously.
5141 C The system loses extra energy.
5142 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5149 c------------------------------------------------------------------------------
5150 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5152 C This subroutine calculates multi-body contributions to hydrogen-bonding
5153 implicit real*8 (a-h,o-z)
5154 include 'DIMENSIONS'
5155 include 'DIMENSIONS.ZSCOPT'
5156 include 'COMMON.IOUNITS'
5158 include 'COMMON.INFO'
5160 include 'COMMON.FFIELD'
5161 include 'COMMON.DERIV'
5162 include 'COMMON.INTERACT'
5163 include 'COMMON.CONTACTS'
5165 parameter (max_cont=maxconts)
5166 parameter (max_dim=2*(8*3+2))
5167 parameter (msglen1=max_cont*max_dim*4)
5168 parameter (msglen2=2*msglen1)
5169 integer source,CorrelType,CorrelID,Error
5170 double precision buffer(max_cont,max_dim)
5172 double precision gx(3),gx1(3)
5175 C Set lprn=.true. for debugging
5181 if (fgProcs.le.1) goto 30
5183 write (iout,'(a)') 'Contact function values:'
5185 write (iout,'(2i3,50(1x,i2,f5.2))')
5186 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5187 & j=1,num_cont_hb(i))
5190 C Caution! Following code assumes that electrostatic interactions concerning
5191 C a given atom are split among at most two processors!
5201 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5204 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5205 if (MyRank.gt.0) then
5206 C Send correlation contributions to the preceding processor
5208 nn=num_cont_hb(iatel_s)
5209 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5210 cd write (iout,*) 'The BUFFER array:'
5212 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5214 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5216 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5217 C Clear the contacts of the atom passed to the neighboring processor
5218 nn=num_cont_hb(iatel_s+1)
5220 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5222 num_cont_hb(iatel_s)=0
5224 cd write (iout,*) 'Processor ',MyID,MyRank,
5225 cd & ' is sending correlation contribution to processor',MyID-1,
5226 cd & ' msglen=',msglen
5227 cd write (*,*) 'Processor ',MyID,MyRank,
5228 cd & ' is sending correlation contribution to processor',MyID-1,
5229 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5230 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5231 cd write (iout,*) 'Processor ',MyID,
5232 cd & ' has sent correlation contribution to processor',MyID-1,
5233 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5234 cd write (*,*) 'Processor ',MyID,
5235 cd & ' has sent correlation contribution to processor',MyID-1,
5236 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5238 endif ! (MyRank.gt.0)
5242 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5243 if (MyRank.lt.fgProcs-1) then
5244 C Receive correlation contributions from the next processor
5246 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5247 cd write (iout,*) 'Processor',MyID,
5248 cd & ' is receiving correlation contribution from processor',MyID+1,
5249 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5250 cd write (*,*) 'Processor',MyID,
5251 cd & ' is receiving correlation contribution from processor',MyID+1,
5252 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5254 do while (nbytes.le.0)
5255 call mp_probe(MyID+1,CorrelType,nbytes)
5257 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5258 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5259 cd write (iout,*) 'Processor',MyID,
5260 cd & ' has received correlation contribution from processor',MyID+1,
5261 cd & ' msglen=',msglen,' nbytes=',nbytes
5262 cd write (iout,*) 'The received BUFFER array:'
5264 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5266 if (msglen.eq.msglen1) then
5267 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5268 else if (msglen.eq.msglen2) then
5269 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5270 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5273 & 'ERROR!!!! message length changed while processing correlations.'
5275 & 'ERROR!!!! message length changed while processing correlations.'
5276 call mp_stopall(Error)
5277 endif ! msglen.eq.msglen1
5278 endif ! MyRank.lt.fgProcs-1
5285 write (iout,'(a)') 'Contact function values:'
5287 write (iout,'(2i3,50(1x,i2,f5.2))')
5288 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5289 & j=1,num_cont_hb(i))
5295 C Remove the loop below after debugging !!!
5302 C Calculate the dipole-dipole interaction energies
5303 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5304 do i=iatel_s,iatel_e+1
5305 num_conti=num_cont_hb(i)
5312 C Calculate the local-electrostatic correlation terms
5313 do i=iatel_s,iatel_e+1
5315 num_conti=num_cont_hb(i)
5316 num_conti1=num_cont_hb(i+1)
5321 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5322 c & ' jj=',jj,' kk=',kk
5323 if (j1.eq.j+1 .or. j1.eq.j-1) then
5324 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5325 C The system gains extra energy.
5327 sqd1=dsqrt(d_cont(jj,i))
5328 sqd2=dsqrt(d_cont(kk,i1))
5329 sred_geom = sqd1*sqd2
5330 IF (sred_geom.lt.cutoff_corr) THEN
5331 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5333 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5334 c & ' jj=',jj,' kk=',kk
5335 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5336 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5338 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5339 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5342 cd write (iout,*) 'sred_geom=',sred_geom,
5343 cd & ' ekont=',ekont,' fprim=',fprimcont
5344 call calc_eello(i,j,i+1,j1,jj,kk)
5345 if (wcorr4.gt.0.0d0)
5346 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5347 if (wcorr5.gt.0.0d0)
5348 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5349 c print *,"wcorr5",ecorr5
5350 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5351 cd write(2,*)'ijkl',i,j,i+1,j1
5352 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5353 & .or. wturn6.eq.0.0d0))then
5354 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5355 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5356 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5357 cd & 'ecorr6=',ecorr6
5358 cd write (iout,'(4e15.5)') sred_geom,
5359 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5360 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5361 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5362 else if (wturn6.gt.0.0d0
5363 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5364 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5365 eturn6=eturn6+eello_turn6(i,jj,kk)
5366 cd write (2,*) 'multibody_eello:eturn6',eturn6
5370 else if (j1.eq.j) then
5371 C Contacts I-J and I-(J+1) occur simultaneously.
5372 C The system loses extra energy.
5373 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5378 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5379 c & ' jj=',jj,' kk=',kk
5381 C Contacts I-J and (I+1)-J occur simultaneously.
5382 C The system loses extra energy.
5383 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5390 c------------------------------------------------------------------------------
5391 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5392 implicit real*8 (a-h,o-z)
5393 include 'DIMENSIONS'
5394 include 'COMMON.IOUNITS'
5395 include 'COMMON.DERIV'
5396 include 'COMMON.INTERACT'
5397 include 'COMMON.CONTACTS'
5398 double precision gx(3),gx1(3)
5408 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5409 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5410 C Following 4 lines for diagnostics.
5415 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5417 c write (iout,*)'Contacts have occurred for peptide groups',
5418 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5419 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5420 C Calculate the multi-body contribution to energy.
5421 ecorr=ecorr+ekont*ees
5423 C Calculate multi-body contributions to the gradient.
5425 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5426 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5427 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5428 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5429 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5430 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5431 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5432 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5433 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5434 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5435 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5436 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5437 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5438 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5442 gradcorr(ll,m)=gradcorr(ll,m)+
5443 & ees*ekl*gacont_hbr(ll,jj,i)-
5444 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5445 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5450 gradcorr(ll,m)=gradcorr(ll,m)+
5451 & ees*eij*gacont_hbr(ll,kk,k)-
5452 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5453 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5460 C---------------------------------------------------------------------------
5461 subroutine dipole(i,j,jj)
5462 implicit real*8 (a-h,o-z)
5463 include 'DIMENSIONS'
5464 include 'DIMENSIONS.ZSCOPT'
5465 include 'COMMON.IOUNITS'
5466 include 'COMMON.CHAIN'
5467 include 'COMMON.FFIELD'
5468 include 'COMMON.DERIV'
5469 include 'COMMON.INTERACT'
5470 include 'COMMON.CONTACTS'
5471 include 'COMMON.TORSION'
5472 include 'COMMON.VAR'
5473 include 'COMMON.GEO'
5474 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5476 iti1 = itortyp(itype(i+1))
5477 if (j.lt.nres-1) then
5478 if (itype(j).le.ntyp) then
5479 itj1 = itortyp(itype(j+1))
5487 dipi(iii,1)=Ub2(iii,i)
5488 dipderi(iii)=Ub2der(iii,i)
5489 dipi(iii,2)=b1(iii,iti1)
5490 dipj(iii,1)=Ub2(iii,j)
5491 dipderj(iii)=Ub2der(iii,j)
5492 dipj(iii,2)=b1(iii,itj1)
5496 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5499 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5502 if (.not.calc_grad) return
5507 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5511 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5516 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5517 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5519 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5521 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5523 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5527 C---------------------------------------------------------------------------
5528 subroutine calc_eello(i,j,k,l,jj,kk)
5530 C This subroutine computes matrices and vectors needed to calculate
5531 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5533 implicit real*8 (a-h,o-z)
5534 include 'DIMENSIONS'
5535 include 'DIMENSIONS.ZSCOPT'
5536 include 'COMMON.IOUNITS'
5537 include 'COMMON.CHAIN'
5538 include 'COMMON.DERIV'
5539 include 'COMMON.INTERACT'
5540 include 'COMMON.CONTACTS'
5541 include 'COMMON.TORSION'
5542 include 'COMMON.VAR'
5543 include 'COMMON.GEO'
5544 include 'COMMON.FFIELD'
5545 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5546 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5549 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5550 cd & ' jj=',jj,' kk=',kk
5551 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5554 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5555 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5558 call transpose2(aa1(1,1),aa1t(1,1))
5559 call transpose2(aa2(1,1),aa2t(1,1))
5562 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5563 & aa1tder(1,1,lll,kkk))
5564 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5565 & aa2tder(1,1,lll,kkk))
5569 C parallel orientation of the two CA-CA-CA frames.
5570 if (i.gt.1 .and. itype(i).le.ntyp) then
5571 iti=itortyp(itype(i))
5575 itk1=itortyp(itype(k+1))
5576 itj=itortyp(itype(j))
5577 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5578 itl1=itortyp(itype(l+1))
5582 C A1 kernel(j+1) A2T
5584 cd write (iout,'(3f10.5,5x,3f10.5)')
5585 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5587 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5588 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5589 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5590 C Following matrices are needed only for 6-th order cumulants
5591 IF (wcorr6.gt.0.0d0) THEN
5592 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5593 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5594 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5595 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5596 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5597 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5598 & ADtEAderx(1,1,1,1,1,1))
5600 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5601 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5602 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5603 & ADtEA1derx(1,1,1,1,1,1))
5605 C End 6-th order cumulants
5608 cd write (2,*) 'In calc_eello6'
5610 cd write (2,*) 'iii=',iii
5612 cd write (2,*) 'kkk=',kkk
5614 cd write (2,'(3(2f10.5),5x)')
5615 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5620 call transpose2(EUgder(1,1,k),auxmat(1,1))
5621 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5622 call transpose2(EUg(1,1,k),auxmat(1,1))
5623 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5624 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5628 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5629 & EAEAderx(1,1,lll,kkk,iii,1))
5633 C A1T kernel(i+1) A2
5634 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5635 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5636 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5637 C Following matrices are needed only for 6-th order cumulants
5638 IF (wcorr6.gt.0.0d0) THEN
5639 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5640 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5641 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5642 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5643 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5644 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5645 & ADtEAderx(1,1,1,1,1,2))
5646 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5647 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5648 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5649 & ADtEA1derx(1,1,1,1,1,2))
5651 C End 6-th order cumulants
5652 call transpose2(EUgder(1,1,l),auxmat(1,1))
5653 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5654 call transpose2(EUg(1,1,l),auxmat(1,1))
5655 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5656 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5660 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5661 & EAEAderx(1,1,lll,kkk,iii,2))
5666 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5667 C They are needed only when the fifth- or the sixth-order cumulants are
5669 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5670 call transpose2(AEA(1,1,1),auxmat(1,1))
5671 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5672 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5673 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5674 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5675 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5676 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5677 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5678 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5679 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5680 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5681 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5682 call transpose2(AEA(1,1,2),auxmat(1,1))
5683 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5684 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5685 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5686 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5687 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5688 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5689 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5690 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5691 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5692 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5693 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5694 C Calculate the Cartesian derivatives of the vectors.
5698 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5699 call matvec2(auxmat(1,1),b1(1,iti),
5700 & AEAb1derx(1,lll,kkk,iii,1,1))
5701 call matvec2(auxmat(1,1),Ub2(1,i),
5702 & AEAb2derx(1,lll,kkk,iii,1,1))
5703 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5704 & AEAb1derx(1,lll,kkk,iii,2,1))
5705 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5706 & AEAb2derx(1,lll,kkk,iii,2,1))
5707 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5708 call matvec2(auxmat(1,1),b1(1,itj),
5709 & AEAb1derx(1,lll,kkk,iii,1,2))
5710 call matvec2(auxmat(1,1),Ub2(1,j),
5711 & AEAb2derx(1,lll,kkk,iii,1,2))
5712 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5713 & AEAb1derx(1,lll,kkk,iii,2,2))
5714 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5715 & AEAb2derx(1,lll,kkk,iii,2,2))
5722 C Antiparallel orientation of the two CA-CA-CA frames.
5723 if (i.gt.1 .and. itype(i).le.ntyp) then
5724 iti=itortyp(itype(i))
5728 itk1=itortyp(itype(k+1))
5729 itl=itortyp(itype(l))
5730 itj=itortyp(itype(j))
5731 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5732 itj1=itortyp(itype(j+1))
5736 C A2 kernel(j-1)T A1T
5737 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5738 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5739 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5740 C Following matrices are needed only for 6-th order cumulants
5741 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5742 & j.eq.i+4 .and. l.eq.i+3)) THEN
5743 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5744 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5745 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5746 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5747 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5748 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5749 & ADtEAderx(1,1,1,1,1,1))
5750 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5751 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5752 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5753 & ADtEA1derx(1,1,1,1,1,1))
5755 C End 6-th order cumulants
5756 call transpose2(EUgder(1,1,k),auxmat(1,1))
5757 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5758 call transpose2(EUg(1,1,k),auxmat(1,1))
5759 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5760 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5764 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5765 & EAEAderx(1,1,lll,kkk,iii,1))
5769 C A2T kernel(i+1)T A1
5770 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5771 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5772 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5773 C Following matrices are needed only for 6-th order cumulants
5774 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5775 & j.eq.i+4 .and. l.eq.i+3)) THEN
5776 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5777 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5778 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5779 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5780 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5781 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5782 & ADtEAderx(1,1,1,1,1,2))
5783 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5784 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5785 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5786 & ADtEA1derx(1,1,1,1,1,2))
5788 C End 6-th order cumulants
5789 call transpose2(EUgder(1,1,j),auxmat(1,1))
5790 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5791 call transpose2(EUg(1,1,j),auxmat(1,1))
5792 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5793 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5797 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5798 & EAEAderx(1,1,lll,kkk,iii,2))
5803 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5804 C They are needed only when the fifth- or the sixth-order cumulants are
5806 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5807 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5808 call transpose2(AEA(1,1,1),auxmat(1,1))
5809 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5810 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5811 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5812 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5813 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5814 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5815 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5816 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5817 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5818 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5819 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5820 call transpose2(AEA(1,1,2),auxmat(1,1))
5821 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5822 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5823 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5824 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5825 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5826 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5827 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5828 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5829 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5830 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5831 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5832 C Calculate the Cartesian derivatives of the vectors.
5836 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5837 call matvec2(auxmat(1,1),b1(1,iti),
5838 & AEAb1derx(1,lll,kkk,iii,1,1))
5839 call matvec2(auxmat(1,1),Ub2(1,i),
5840 & AEAb2derx(1,lll,kkk,iii,1,1))
5841 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5842 & AEAb1derx(1,lll,kkk,iii,2,1))
5843 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5844 & AEAb2derx(1,lll,kkk,iii,2,1))
5845 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5846 call matvec2(auxmat(1,1),b1(1,itl),
5847 & AEAb1derx(1,lll,kkk,iii,1,2))
5848 call matvec2(auxmat(1,1),Ub2(1,l),
5849 & AEAb2derx(1,lll,kkk,iii,1,2))
5850 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5851 & AEAb1derx(1,lll,kkk,iii,2,2))
5852 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5853 & AEAb2derx(1,lll,kkk,iii,2,2))
5862 C---------------------------------------------------------------------------
5863 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5864 & KK,KKderg,AKA,AKAderg,AKAderx)
5868 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5869 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5870 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5875 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5877 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5880 cd if (lprn) write (2,*) 'In kernel'
5882 cd if (lprn) write (2,*) 'kkk=',kkk
5884 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5885 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5887 cd write (2,*) 'lll=',lll
5888 cd write (2,*) 'iii=1'
5890 cd write (2,'(3(2f10.5),5x)')
5891 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5894 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5895 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5897 cd write (2,*) 'lll=',lll
5898 cd write (2,*) 'iii=2'
5900 cd write (2,'(3(2f10.5),5x)')
5901 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5908 C---------------------------------------------------------------------------
5909 double precision function eello4(i,j,k,l,jj,kk)
5910 implicit real*8 (a-h,o-z)
5911 include 'DIMENSIONS'
5912 include 'DIMENSIONS.ZSCOPT'
5913 include 'COMMON.IOUNITS'
5914 include 'COMMON.CHAIN'
5915 include 'COMMON.DERIV'
5916 include 'COMMON.INTERACT'
5917 include 'COMMON.CONTACTS'
5918 include 'COMMON.TORSION'
5919 include 'COMMON.VAR'
5920 include 'COMMON.GEO'
5921 double precision pizda(2,2),ggg1(3),ggg2(3)
5922 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5926 cd print *,'eello4:',i,j,k,l,jj,kk
5927 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5928 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5929 cold eij=facont_hb(jj,i)
5930 cold ekl=facont_hb(kk,k)
5932 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5934 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5935 gcorr_loc(k-1)=gcorr_loc(k-1)
5936 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5938 gcorr_loc(l-1)=gcorr_loc(l-1)
5939 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5941 gcorr_loc(j-1)=gcorr_loc(j-1)
5942 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5947 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5948 & -EAEAderx(2,2,lll,kkk,iii,1)
5949 cd derx(lll,kkk,iii)=0.0d0
5953 cd gcorr_loc(l-1)=0.0d0
5954 cd gcorr_loc(j-1)=0.0d0
5955 cd gcorr_loc(k-1)=0.0d0
5957 cd write (iout,*)'Contacts have occurred for peptide groups',
5958 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5959 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5960 if (j.lt.nres-1) then
5967 if (l.lt.nres-1) then
5975 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5976 ggg1(ll)=eel4*g_contij(ll,1)
5977 ggg2(ll)=eel4*g_contij(ll,2)
5978 ghalf=0.5d0*ggg1(ll)
5980 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5981 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5982 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5983 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5984 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5985 ghalf=0.5d0*ggg2(ll)
5987 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5988 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5989 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5990 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5995 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5996 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6001 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6002 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6008 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6013 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6017 cd write (2,*) iii,gcorr_loc(iii)
6021 cd write (2,*) 'ekont',ekont
6022 cd write (iout,*) 'eello4',ekont*eel4
6025 C---------------------------------------------------------------------------
6026 double precision function eello5(i,j,k,l,jj,kk)
6027 implicit real*8 (a-h,o-z)
6028 include 'DIMENSIONS'
6029 include 'DIMENSIONS.ZSCOPT'
6030 include 'COMMON.IOUNITS'
6031 include 'COMMON.CHAIN'
6032 include 'COMMON.DERIV'
6033 include 'COMMON.INTERACT'
6034 include 'COMMON.CONTACTS'
6035 include 'COMMON.TORSION'
6036 include 'COMMON.VAR'
6037 include 'COMMON.GEO'
6038 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6039 double precision ggg1(3),ggg2(3)
6040 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6045 C /l\ / \ \ / \ / \ / C
6046 C / \ / \ \ / \ / \ / C
6047 C j| o |l1 | o | o| o | | o |o C
6048 C \ |/k\| |/ \| / |/ \| |/ \| C
6049 C \i/ \ / \ / / \ / \ C
6051 C (I) (II) (III) (IV) C
6053 C eello5_1 eello5_2 eello5_3 eello5_4 C
6055 C Antiparallel chains C
6058 C /j\ / \ \ / \ / \ / C
6059 C / \ / \ \ / \ / \ / C
6060 C j1| o |l | o | o| o | | o |o C
6061 C \ |/k\| |/ \| / |/ \| |/ \| C
6062 C \i/ \ / \ / / \ / \ C
6064 C (I) (II) (III) (IV) C
6066 C eello5_1 eello5_2 eello5_3 eello5_4 C
6068 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6070 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6071 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6076 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6078 itk=itortyp(itype(k))
6079 itl=itortyp(itype(l))
6080 itj=itortyp(itype(j))
6085 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6086 cd & eel5_3_num,eel5_4_num)
6090 derx(lll,kkk,iii)=0.0d0
6094 cd eij=facont_hb(jj,i)
6095 cd ekl=facont_hb(kk,k)
6097 cd write (iout,*)'Contacts have occurred for peptide groups',
6098 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6100 C Contribution from the graph I.
6101 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6102 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6103 call transpose2(EUg(1,1,k),auxmat(1,1))
6104 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6105 vv(1)=pizda(1,1)-pizda(2,2)
6106 vv(2)=pizda(1,2)+pizda(2,1)
6107 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6108 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6110 C Explicit gradient in virtual-dihedral angles.
6111 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6112 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6113 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6114 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6115 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6116 vv(1)=pizda(1,1)-pizda(2,2)
6117 vv(2)=pizda(1,2)+pizda(2,1)
6118 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6119 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6120 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6121 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6122 vv(1)=pizda(1,1)-pizda(2,2)
6123 vv(2)=pizda(1,2)+pizda(2,1)
6125 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6126 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6127 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6129 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6130 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6131 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6133 C Cartesian gradient
6137 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6139 vv(1)=pizda(1,1)-pizda(2,2)
6140 vv(2)=pizda(1,2)+pizda(2,1)
6141 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6142 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6143 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6150 C Contribution from graph II
6151 call transpose2(EE(1,1,itk),auxmat(1,1))
6152 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6153 vv(1)=pizda(1,1)+pizda(2,2)
6154 vv(2)=pizda(2,1)-pizda(1,2)
6155 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6156 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6158 C Explicit gradient in virtual-dihedral angles.
6159 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6160 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6161 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6162 vv(1)=pizda(1,1)+pizda(2,2)
6163 vv(2)=pizda(2,1)-pizda(1,2)
6165 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6166 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6167 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6169 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6170 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6171 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6173 C Cartesian gradient
6177 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6179 vv(1)=pizda(1,1)+pizda(2,2)
6180 vv(2)=pizda(2,1)-pizda(1,2)
6181 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6182 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6183 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6192 C Parallel orientation
6193 C Contribution from graph III
6194 call transpose2(EUg(1,1,l),auxmat(1,1))
6195 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6196 vv(1)=pizda(1,1)-pizda(2,2)
6197 vv(2)=pizda(1,2)+pizda(2,1)
6198 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6199 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6201 C Explicit gradient in virtual-dihedral angles.
6202 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6203 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6204 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6205 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6206 vv(1)=pizda(1,1)-pizda(2,2)
6207 vv(2)=pizda(1,2)+pizda(2,1)
6208 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6209 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6210 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6211 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6212 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6213 vv(1)=pizda(1,1)-pizda(2,2)
6214 vv(2)=pizda(1,2)+pizda(2,1)
6215 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6216 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6217 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6218 C Cartesian gradient
6222 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6224 vv(1)=pizda(1,1)-pizda(2,2)
6225 vv(2)=pizda(1,2)+pizda(2,1)
6226 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6227 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6228 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6234 C Contribution from graph IV
6236 call transpose2(EE(1,1,itl),auxmat(1,1))
6237 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6238 vv(1)=pizda(1,1)+pizda(2,2)
6239 vv(2)=pizda(2,1)-pizda(1,2)
6240 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6241 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6243 C Explicit gradient in virtual-dihedral angles.
6244 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6245 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6246 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6247 vv(1)=pizda(1,1)+pizda(2,2)
6248 vv(2)=pizda(2,1)-pizda(1,2)
6249 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6250 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6251 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6252 C Cartesian gradient
6256 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6258 vv(1)=pizda(1,1)+pizda(2,2)
6259 vv(2)=pizda(2,1)-pizda(1,2)
6260 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6261 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6262 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6268 C Antiparallel orientation
6269 C Contribution from graph III
6271 call transpose2(EUg(1,1,j),auxmat(1,1))
6272 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6273 vv(1)=pizda(1,1)-pizda(2,2)
6274 vv(2)=pizda(1,2)+pizda(2,1)
6275 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6276 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6278 C Explicit gradient in virtual-dihedral angles.
6279 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6280 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6281 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6282 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6283 vv(1)=pizda(1,1)-pizda(2,2)
6284 vv(2)=pizda(1,2)+pizda(2,1)
6285 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6286 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6287 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6288 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6289 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6290 vv(1)=pizda(1,1)-pizda(2,2)
6291 vv(2)=pizda(1,2)+pizda(2,1)
6292 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6293 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6294 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6295 C Cartesian gradient
6299 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6301 vv(1)=pizda(1,1)-pizda(2,2)
6302 vv(2)=pizda(1,2)+pizda(2,1)
6303 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6304 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6305 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6311 C Contribution from graph IV
6313 call transpose2(EE(1,1,itj),auxmat(1,1))
6314 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6315 vv(1)=pizda(1,1)+pizda(2,2)
6316 vv(2)=pizda(2,1)-pizda(1,2)
6317 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6318 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6320 C Explicit gradient in virtual-dihedral angles.
6321 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6322 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6323 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6324 vv(1)=pizda(1,1)+pizda(2,2)
6325 vv(2)=pizda(2,1)-pizda(1,2)
6326 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6327 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6328 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6329 C Cartesian gradient
6333 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6335 vv(1)=pizda(1,1)+pizda(2,2)
6336 vv(2)=pizda(2,1)-pizda(1,2)
6337 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6338 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6339 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6346 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6347 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6348 cd write (2,*) 'ijkl',i,j,k,l
6349 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6350 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6352 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6353 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6354 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6355 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6357 if (j.lt.nres-1) then
6364 if (l.lt.nres-1) then
6374 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6376 ggg1(ll)=eel5*g_contij(ll,1)
6377 ggg2(ll)=eel5*g_contij(ll,2)
6378 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6379 ghalf=0.5d0*ggg1(ll)
6381 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6382 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6383 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6384 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6385 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6386 ghalf=0.5d0*ggg2(ll)
6388 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6389 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6390 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6391 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6396 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6397 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6402 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6403 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6409 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6414 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6418 cd write (2,*) iii,g_corr5_loc(iii)
6422 cd write (2,*) 'ekont',ekont
6423 cd write (iout,*) 'eello5',ekont*eel5
6426 c--------------------------------------------------------------------------
6427 double precision function eello6(i,j,k,l,jj,kk)
6428 implicit real*8 (a-h,o-z)
6429 include 'DIMENSIONS'
6430 include 'DIMENSIONS.ZSCOPT'
6431 include 'COMMON.IOUNITS'
6432 include 'COMMON.CHAIN'
6433 include 'COMMON.DERIV'
6434 include 'COMMON.INTERACT'
6435 include 'COMMON.CONTACTS'
6436 include 'COMMON.TORSION'
6437 include 'COMMON.VAR'
6438 include 'COMMON.GEO'
6439 include 'COMMON.FFIELD'
6440 double precision ggg1(3),ggg2(3)
6441 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6446 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6454 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6455 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6459 derx(lll,kkk,iii)=0.0d0
6463 cd eij=facont_hb(jj,i)
6464 cd ekl=facont_hb(kk,k)
6470 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6471 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6472 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6473 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6474 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6475 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6477 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6478 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6479 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6480 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6481 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6482 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6486 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6488 C If turn contributions are considered, they will be handled separately.
6489 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6490 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6491 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6492 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6493 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6494 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6495 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6498 if (j.lt.nres-1) then
6505 if (l.lt.nres-1) then
6513 ggg1(ll)=eel6*g_contij(ll,1)
6514 ggg2(ll)=eel6*g_contij(ll,2)
6515 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6516 ghalf=0.5d0*ggg1(ll)
6518 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6519 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6520 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6521 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6522 ghalf=0.5d0*ggg2(ll)
6523 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6525 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6526 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6527 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6528 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6533 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6534 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6539 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6540 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6546 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6551 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6555 cd write (2,*) iii,g_corr6_loc(iii)
6559 cd write (2,*) 'ekont',ekont
6560 cd write (iout,*) 'eello6',ekont*eel6
6563 c--------------------------------------------------------------------------
6564 double precision function eello6_graph1(i,j,k,l,imat,swap)
6565 implicit real*8 (a-h,o-z)
6566 include 'DIMENSIONS'
6567 include 'DIMENSIONS.ZSCOPT'
6568 include 'COMMON.IOUNITS'
6569 include 'COMMON.CHAIN'
6570 include 'COMMON.DERIV'
6571 include 'COMMON.INTERACT'
6572 include 'COMMON.CONTACTS'
6573 include 'COMMON.TORSION'
6574 include 'COMMON.VAR'
6575 include 'COMMON.GEO'
6576 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6580 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6582 C Parallel Antiparallel C
6588 C \ j|/k\| / \ |/k\|l / C
6593 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6594 itk=itortyp(itype(k))
6595 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6596 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6597 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6598 call transpose2(EUgC(1,1,k),auxmat(1,1))
6599 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6600 vv1(1)=pizda1(1,1)-pizda1(2,2)
6601 vv1(2)=pizda1(1,2)+pizda1(2,1)
6602 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6603 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6604 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6605 s5=scalar2(vv(1),Dtobr2(1,i))
6606 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6607 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6608 if (.not. calc_grad) return
6609 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6610 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6611 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6612 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6613 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6614 & +scalar2(vv(1),Dtobr2der(1,i)))
6615 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6616 vv1(1)=pizda1(1,1)-pizda1(2,2)
6617 vv1(2)=pizda1(1,2)+pizda1(2,1)
6618 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6619 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6621 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6622 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6623 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6624 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6625 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6627 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6628 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6629 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6630 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6631 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6633 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6634 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6635 vv1(1)=pizda1(1,1)-pizda1(2,2)
6636 vv1(2)=pizda1(1,2)+pizda1(2,1)
6637 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6638 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6639 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6640 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6649 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6650 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6651 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6652 call transpose2(EUgC(1,1,k),auxmat(1,1))
6653 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6655 vv1(1)=pizda1(1,1)-pizda1(2,2)
6656 vv1(2)=pizda1(1,2)+pizda1(2,1)
6657 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6658 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6659 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6660 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6661 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6662 s5=scalar2(vv(1),Dtobr2(1,i))
6663 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6669 c----------------------------------------------------------------------------
6670 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6671 implicit real*8 (a-h,o-z)
6672 include 'DIMENSIONS'
6673 include 'DIMENSIONS.ZSCOPT'
6674 include 'COMMON.IOUNITS'
6675 include 'COMMON.CHAIN'
6676 include 'COMMON.DERIV'
6677 include 'COMMON.INTERACT'
6678 include 'COMMON.CONTACTS'
6679 include 'COMMON.TORSION'
6680 include 'COMMON.VAR'
6681 include 'COMMON.GEO'
6683 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6684 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6687 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6689 C Parallel Antiparallel C
6695 C \ j|/k\| \ |/k\|l C
6700 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6701 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6702 C AL 7/4/01 s1 would occur in the sixth-order moment,
6703 C but not in a cluster cumulant
6705 s1=dip(1,jj,i)*dip(1,kk,k)
6707 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6708 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6709 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6710 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6711 call transpose2(EUg(1,1,k),auxmat(1,1))
6712 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6713 vv(1)=pizda(1,1)-pizda(2,2)
6714 vv(2)=pizda(1,2)+pizda(2,1)
6715 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6716 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6718 eello6_graph2=-(s1+s2+s3+s4)
6720 eello6_graph2=-(s2+s3+s4)
6723 if (.not. calc_grad) return
6724 C Derivatives in gamma(i-1)
6727 s1=dipderg(1,jj,i)*dip(1,kk,k)
6729 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6730 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6731 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6732 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6734 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6736 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6738 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6740 C Derivatives in gamma(k-1)
6742 s1=dip(1,jj,i)*dipderg(1,kk,k)
6744 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6745 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6746 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6747 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6748 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6749 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6750 vv(1)=pizda(1,1)-pizda(2,2)
6751 vv(2)=pizda(1,2)+pizda(2,1)
6752 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6754 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6756 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6758 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6759 C Derivatives in gamma(j-1) or gamma(l-1)
6762 s1=dipderg(3,jj,i)*dip(1,kk,k)
6764 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6765 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6766 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6767 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6768 vv(1)=pizda(1,1)-pizda(2,2)
6769 vv(2)=pizda(1,2)+pizda(2,1)
6770 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6773 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6775 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6778 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6779 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6781 C Derivatives in gamma(l-1) or gamma(j-1)
6784 s1=dip(1,jj,i)*dipderg(3,kk,k)
6786 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6787 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6788 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6789 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6790 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6791 vv(1)=pizda(1,1)-pizda(2,2)
6792 vv(2)=pizda(1,2)+pizda(2,1)
6793 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6796 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6798 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6801 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6802 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6804 C Cartesian derivatives.
6806 write (2,*) 'In eello6_graph2'
6808 write (2,*) 'iii=',iii
6810 write (2,*) 'kkk=',kkk
6812 write (2,'(3(2f10.5),5x)')
6813 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6823 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6825 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6828 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6830 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6831 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6833 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6834 call transpose2(EUg(1,1,k),auxmat(1,1))
6835 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6837 vv(1)=pizda(1,1)-pizda(2,2)
6838 vv(2)=pizda(1,2)+pizda(2,1)
6839 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6840 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6842 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6844 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6847 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6849 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6856 c----------------------------------------------------------------------------
6857 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6858 implicit real*8 (a-h,o-z)
6859 include 'DIMENSIONS'
6860 include 'DIMENSIONS.ZSCOPT'
6861 include 'COMMON.IOUNITS'
6862 include 'COMMON.CHAIN'
6863 include 'COMMON.DERIV'
6864 include 'COMMON.INTERACT'
6865 include 'COMMON.CONTACTS'
6866 include 'COMMON.TORSION'
6867 include 'COMMON.VAR'
6868 include 'COMMON.GEO'
6869 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6871 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6873 C Parallel Antiparallel C
6879 C j|/k\| / |/k\|l / C
6884 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6886 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6887 C energy moment and not to the cluster cumulant.
6888 iti=itortyp(itype(i))
6889 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6890 itj1=itortyp(itype(j+1))
6894 itk=itortyp(itype(k))
6895 itk1=itortyp(itype(k+1))
6896 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6897 itl1=itortyp(itype(l+1))
6902 s1=dip(4,jj,i)*dip(4,kk,k)
6904 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6905 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6906 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6907 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6908 call transpose2(EE(1,1,itk),auxmat(1,1))
6909 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6910 vv(1)=pizda(1,1)+pizda(2,2)
6911 vv(2)=pizda(2,1)-pizda(1,2)
6912 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6913 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6915 eello6_graph3=-(s1+s2+s3+s4)
6917 eello6_graph3=-(s2+s3+s4)
6920 if (.not. calc_grad) return
6921 C Derivatives in gamma(k-1)
6922 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6923 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6924 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6925 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6926 C Derivatives in gamma(l-1)
6927 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6928 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6929 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6930 vv(1)=pizda(1,1)+pizda(2,2)
6931 vv(2)=pizda(2,1)-pizda(1,2)
6932 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6933 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6934 C Cartesian derivatives.
6940 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6942 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6945 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6947 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6948 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6950 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6951 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6953 vv(1)=pizda(1,1)+pizda(2,2)
6954 vv(2)=pizda(2,1)-pizda(1,2)
6955 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6957 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6959 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6962 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6964 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6966 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6972 c----------------------------------------------------------------------------
6973 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6974 implicit real*8 (a-h,o-z)
6975 include 'DIMENSIONS'
6976 include 'DIMENSIONS.ZSCOPT'
6977 include 'COMMON.IOUNITS'
6978 include 'COMMON.CHAIN'
6979 include 'COMMON.DERIV'
6980 include 'COMMON.INTERACT'
6981 include 'COMMON.CONTACTS'
6982 include 'COMMON.TORSION'
6983 include 'COMMON.VAR'
6984 include 'COMMON.GEO'
6985 include 'COMMON.FFIELD'
6986 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6987 & auxvec1(2),auxmat1(2,2)
6989 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6991 C Parallel Antiparallel C
6997 C \ j|/k\| \ |/k\|l C
7002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7004 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7005 C energy moment and not to the cluster cumulant.
7006 cd write (2,*) 'eello_graph4: wturn6',wturn6
7007 iti=itortyp(itype(i))
7008 itj=itortyp(itype(j))
7009 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7010 itj1=itortyp(itype(j+1))
7014 itk=itortyp(itype(k))
7015 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7016 itk1=itortyp(itype(k+1))
7020 itl=itortyp(itype(l))
7021 if (l.lt.nres-1) then
7022 itl1=itortyp(itype(l+1))
7026 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7027 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7028 cd & ' itl',itl,' itl1',itl1
7031 s1=dip(3,jj,i)*dip(3,kk,k)
7033 s1=dip(2,jj,j)*dip(2,kk,l)
7036 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7037 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7039 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7040 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7042 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7043 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7045 call transpose2(EUg(1,1,k),auxmat(1,1))
7046 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7047 vv(1)=pizda(1,1)-pizda(2,2)
7048 vv(2)=pizda(2,1)+pizda(1,2)
7049 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7050 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7052 eello6_graph4=-(s1+s2+s3+s4)
7054 eello6_graph4=-(s2+s3+s4)
7056 if (.not. calc_grad) return
7057 C Derivatives in gamma(i-1)
7061 s1=dipderg(2,jj,i)*dip(3,kk,k)
7063 s1=dipderg(4,jj,j)*dip(2,kk,l)
7066 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7068 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7069 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7071 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7072 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7074 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7075 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7076 cd write (2,*) 'turn6 derivatives'
7078 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7080 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7084 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7086 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7090 C Derivatives in gamma(k-1)
7093 s1=dip(3,jj,i)*dipderg(2,kk,k)
7095 s1=dip(2,jj,j)*dipderg(4,kk,l)
7098 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7099 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7101 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7102 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7104 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7105 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7107 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7108 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7109 vv(1)=pizda(1,1)-pizda(2,2)
7110 vv(2)=pizda(2,1)+pizda(1,2)
7111 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7112 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7114 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7116 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7120 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7122 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7125 C Derivatives in gamma(j-1) or gamma(l-1)
7126 if (l.eq.j+1 .and. l.gt.1) then
7127 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7128 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7129 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7130 vv(1)=pizda(1,1)-pizda(2,2)
7131 vv(2)=pizda(2,1)+pizda(1,2)
7132 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7133 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7134 else if (j.gt.1) then
7135 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7136 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7137 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7138 vv(1)=pizda(1,1)-pizda(2,2)
7139 vv(2)=pizda(2,1)+pizda(1,2)
7140 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7141 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7142 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7144 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7147 C Cartesian derivatives.
7154 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7156 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7160 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7162 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7166 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7168 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7170 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7171 & b1(1,itj1),auxvec(1))
7172 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7174 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7175 & b1(1,itl1),auxvec(1))
7176 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7178 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7180 vv(1)=pizda(1,1)-pizda(2,2)
7181 vv(2)=pizda(2,1)+pizda(1,2)
7182 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7184 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7186 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7189 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7192 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7195 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7197 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7199 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7203 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7205 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7208 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7210 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7218 c----------------------------------------------------------------------------
7219 double precision function eello_turn6(i,jj,kk)
7220 implicit real*8 (a-h,o-z)
7221 include 'DIMENSIONS'
7222 include 'DIMENSIONS.ZSCOPT'
7223 include 'COMMON.IOUNITS'
7224 include 'COMMON.CHAIN'
7225 include 'COMMON.DERIV'
7226 include 'COMMON.INTERACT'
7227 include 'COMMON.CONTACTS'
7228 include 'COMMON.TORSION'
7229 include 'COMMON.VAR'
7230 include 'COMMON.GEO'
7231 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7232 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7234 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7235 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7236 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7237 C the respective energy moment and not to the cluster cumulant.
7242 iti=itortyp(itype(i))
7243 itk=itortyp(itype(k))
7244 itk1=itortyp(itype(k+1))
7245 itl=itortyp(itype(l))
7246 itj=itortyp(itype(j))
7247 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7248 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7249 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7254 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7256 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7260 derx_turn(lll,kkk,iii)=0.0d0
7267 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7269 cd write (2,*) 'eello6_5',eello6_5
7271 call transpose2(AEA(1,1,1),auxmat(1,1))
7272 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7273 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7274 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7278 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7279 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7280 s2 = scalar2(b1(1,itk),vtemp1(1))
7282 call transpose2(AEA(1,1,2),atemp(1,1))
7283 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7284 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7285 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7289 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7290 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7291 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7293 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7294 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7295 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7296 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7297 ss13 = scalar2(b1(1,itk),vtemp4(1))
7298 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7302 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7308 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7310 C Derivatives in gamma(i+2)
7312 call transpose2(AEA(1,1,1),auxmatd(1,1))
7313 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7314 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7315 call transpose2(AEAderg(1,1,2),atempd(1,1))
7316 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7317 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7321 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7322 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7323 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7329 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7330 C Derivatives in gamma(i+3)
7332 call transpose2(AEA(1,1,1),auxmatd(1,1))
7333 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7334 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7335 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7339 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7340 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7341 s2d = scalar2(b1(1,itk),vtemp1d(1))
7343 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7344 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7346 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7348 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7349 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7350 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7360 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7361 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7363 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7364 & -0.5d0*ekont*(s2d+s12d)
7366 C Derivatives in gamma(i+4)
7367 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7368 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7369 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7371 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7372 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7373 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7383 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7385 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7387 C Derivatives in gamma(i+5)
7389 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7390 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7391 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7395 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7396 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7397 s2d = scalar2(b1(1,itk),vtemp1d(1))
7399 call transpose2(AEA(1,1,2),atempd(1,1))
7400 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7401 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7405 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7406 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7408 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7409 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7410 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7420 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7421 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7423 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7424 & -0.5d0*ekont*(s2d+s12d)
7426 C Cartesian derivatives
7431 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7432 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7433 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7437 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7438 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7440 s2d = scalar2(b1(1,itk),vtemp1d(1))
7442 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7443 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7444 s8d = -(atempd(1,1)+atempd(2,2))*
7445 & scalar2(cc(1,1,itl),vtemp2(1))
7449 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7451 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7452 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7459 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7462 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7466 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7467 & - 0.5d0*(s8d+s12d)
7469 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7478 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7480 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7481 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7482 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7483 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7484 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7486 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7487 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7488 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7492 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7493 cd & 16*eel_turn6_num
7495 if (j.lt.nres-1) then
7502 if (l.lt.nres-1) then
7510 ggg1(ll)=eel_turn6*g_contij(ll,1)
7511 ggg2(ll)=eel_turn6*g_contij(ll,2)
7512 ghalf=0.5d0*ggg1(ll)
7514 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7515 & +ekont*derx_turn(ll,2,1)
7516 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7517 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7518 & +ekont*derx_turn(ll,4,1)
7519 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7520 ghalf=0.5d0*ggg2(ll)
7522 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7523 & +ekont*derx_turn(ll,2,2)
7524 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7525 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7526 & +ekont*derx_turn(ll,4,2)
7527 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7532 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7537 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7543 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7548 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7552 cd write (2,*) iii,g_corr6_loc(iii)
7555 eello_turn6=ekont*eel_turn6
7556 cd write (2,*) 'ekont',ekont
7557 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7560 crc-------------------------------------------------
7561 SUBROUTINE MATVEC2(A1,V1,V2)
7562 implicit real*8 (a-h,o-z)
7563 include 'DIMENSIONS'
7564 DIMENSION A1(2,2),V1(2),V2(2)
7568 c 3 VI=VI+A1(I,K)*V1(K)
7572 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7573 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7578 C---------------------------------------
7579 SUBROUTINE MATMAT2(A1,A2,A3)
7580 implicit real*8 (a-h,o-z)
7581 include 'DIMENSIONS'
7582 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7583 c DIMENSION AI3(2,2)
7587 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7593 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7594 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7595 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7596 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7604 c-------------------------------------------------------------------------
7605 double precision function scalar2(u,v)
7607 double precision u(2),v(2)
7610 scalar2=u(1)*v(1)+u(2)*v(2)
7614 C-----------------------------------------------------------------------------
7616 subroutine transpose2(a,at)
7618 double precision a(2,2),at(2,2)
7625 c--------------------------------------------------------------------------
7626 subroutine transpose(n,a,at)
7629 double precision a(n,n),at(n,n)
7637 C---------------------------------------------------------------------------
7638 subroutine prodmat3(a1,a2,kk,transp,prod)
7641 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7643 crc double precision auxmat(2,2),prod_(2,2)
7646 crc call transpose2(kk(1,1),auxmat(1,1))
7647 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7648 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7650 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7651 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7652 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7653 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7654 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7655 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7656 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7657 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7660 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7661 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7663 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7664 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7665 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7666 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7667 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7668 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7669 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7670 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7673 c call transpose2(a2(1,1),a2t(1,1))
7676 crc print *,((prod_(i,j),i=1,2),j=1,2)
7677 crc print *,((prod(i,j),i=1,2),j=1,2)
7681 C-----------------------------------------------------------------------------
7682 double precision function scalar(u,v)
7684 double precision u(3),v(3)