1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
5 include 'DIMENSIONS.FREE'
11 cMS$ATTRIBUTES C :: proc_proc
14 include 'COMMON.IOUNITS'
15 double precision energia(0:max_ene),energia1(0:max_ene+1)
21 include 'COMMON.FFIELD'
22 include 'COMMON.DERIV'
23 include 'COMMON.INTERACT'
24 include 'COMMON.SBRIDGE'
25 include 'COMMON.CHAIN'
26 include 'COMMON.CONTROL'
27 double precision fact(6)
28 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
29 cd print *,'nnt=',nnt,' nct=',nct
31 C Compute the side-chain and electrostatic interaction energy
33 goto (101,102,103,104,105) ipot
34 C Lennard-Jones potential.
35 101 call elj(evdw,evdw_t)
36 cd print '(a)','Exit ELJ'
38 C Lennard-Jones-Kihara potential (shifted).
39 102 call eljk(evdw,evdw_t)
41 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 103 call ebp(evdw,evdw_t)
44 C Gay-Berne potential (shifted LJ, angular dependence).
45 104 call egb(evdw,evdw_t)
47 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 105 call egbv(evdw,evdw_t)
50 C Calculate electrostatic (H-bonding) energy of the main chain.
52 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
54 C Calculate excluded-volume interaction energy between peptide groups
57 call escp(evdw2,evdw2_14)
59 c Calculate the bond-stretching energy
62 c write (iout,*) "estr",estr
64 C Calculate the disulfide-bridge and other energy and the contributions
65 C from other distance constraints.
66 cd print *,'Calling EHPB'
68 cd print *,'EHPB exitted succesfully.'
70 C Calculate the virtual-bond-angle energy.
73 cd print *,'Bend energy finished.'
75 C Calculate the SC local energy.
78 cd print *,'SCLOC energy finished.'
80 C Calculate the virtual-bond torsional energy.
82 cd print *,'nterm=',nterm
83 call etor(etors,edihcnstr,fact(1))
85 C 6/23/01 Calculate double-torsional energy
87 call etor_d(etors_d,fact(2))
89 C 21/5/07 Calculate local sicdechain correlation energy
91 call eback_sc_corr(esccor)
93 C 12/1/95 Multi-body terms
97 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
98 & .or. wturn6.gt.0.0d0) then
99 c print *,"calling multibody_eello"
100 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
101 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
102 c print *,ecorr,ecorr5,ecorr6,eturn6
104 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
105 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
109 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
110 if (constr_homology.ge.1) then
111 call e_modeller(ehomology_constr)
113 ehomology_constr=0.0d0
116 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
118 C BARTEK for dfa test!
119 if (wdfa_dist.gt.0) then
124 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
125 if (wdfa_tor.gt.0) then
130 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
131 if (wdfa_nei.gt.0) then
136 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
137 if (wdfa_beta.gt.0) then
142 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
144 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
146 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
148 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
149 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
150 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
151 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
152 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
153 & +wbond*estr+wsccor*fact(1)*esccor!+ehomology_constr
154 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
157 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
158 & +welec*fact(1)*(ees+evdw1)
159 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
160 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
161 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
162 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
163 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
164 & +wbond*estr+wsccor*fact(1)*esccor!+ehomology_constr
165 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
171 energia(2)=evdw2-evdw2_14
188 energia(8)=eello_turn3
189 energia(9)=eello_turn4
198 energia(20)=edihcnstr
200 energia(22)=ehomology_constr
205 c if (dyn_ss) call dyn_set_nss
209 if (isnan(etot).ne.0) energia(0)=1.0d+99
211 if (isnan(etot)) energia(0)=1.0d+99
216 idumm=proc_proc(etot,i)
218 call proc_proc(etot,i)
220 if(i.eq.1)energia(0)=1.0d+99
227 C Sum up the components of the Cartesian gradient.
232 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
233 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
235 & wstrain*ghpbc(j,i)+
236 & wcorr*fact(3)*gradcorr(j,i)+
237 & wel_loc*fact(2)*gel_loc(j,i)+
238 & wturn3*fact(2)*gcorr3_turn(j,i)+
239 & wturn4*fact(3)*gcorr4_turn(j,i)+
240 & wcorr5*fact(4)*gradcorr5(j,i)+
241 & wcorr6*fact(5)*gradcorr6(j,i)+
242 & wturn6*fact(5)*gcorr6_turn(j,i)+
243 & wsccor*fact(2)*gsccorc(j,i)+
244 & wdfa_dist*gdfad(j,i)+
245 & wdfa_tor*gdfat(j,i)+
246 & wdfa_nei*gdfan(j,i)+
247 & wdfa_beta*gdfab(j,i)
248 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
250 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
251 & wsccor*fact(2)*gsccorx(j,i)
256 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
257 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
259 & wcorr*fact(3)*gradcorr(j,i)+
260 & wel_loc*fact(2)*gel_loc(j,i)+
261 & wturn3*fact(2)*gcorr3_turn(j,i)+
262 & wturn4*fact(3)*gcorr4_turn(j,i)+
263 & wcorr5*fact(4)*gradcorr5(j,i)+
264 & wcorr6*fact(5)*gradcorr6(j,i)+
265 & wturn6*fact(5)*gcorr6_turn(j,i)+
266 & wsccor*fact(2)*gsccorc(j,i)+
267 & wdfa_dist*gdfad(j,i)+
268 & wdfa_tor*gdfat(j,i)+
269 & wdfa_nei*gdfan(j,i)+
270 & wdfa_beta*gdfab(j,i)
271 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
273 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
274 & wsccor*fact(1)*gsccorx(j,i)
281 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
282 & +wcorr5*fact(4)*g_corr5_loc(i)
283 & +wcorr6*fact(5)*g_corr6_loc(i)
284 & +wturn4*fact(3)*gel_loc_turn4(i)
285 & +wturn3*fact(2)*gel_loc_turn3(i)
286 & +wturn6*fact(5)*gel_loc_turn6(i)
287 & +wel_loc*fact(2)*gel_loc_loc(i)
288 & +wsccor*fact(1)*gsccor_loc(i)
293 C------------------------------------------------------------------------
294 subroutine enerprint(energia,fact)
295 implicit real*8 (a-h,o-z)
297 include 'DIMENSIONS.ZSCOPT'
298 include 'COMMON.IOUNITS'
299 include 'COMMON.FFIELD'
300 include 'COMMON.SBRIDGE'
301 double precision energia(0:max_ene),fact(6)
303 evdw=energia(1)+fact(6)*energia(21)
305 evdw2=energia(2)+energia(17)
317 eello_turn3=energia(8)
318 eello_turn4=energia(9)
319 eello_turn6=energia(10)
326 edihcnstr=energia(20)
328 ehomology_constr=energia(22)
334 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
336 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
337 & etors_d,wtor_d*fact(2),ehpb,wstrain,
338 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
339 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
340 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
341 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,
342 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
344 10 format (/'Virtual-chain energies:'//
345 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
346 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
347 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
348 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
349 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
350 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
351 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
352 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
353 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
354 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
355 & ' (SS bridges & dist. cnstr.)'/
356 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
357 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
358 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
359 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
360 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
361 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
362 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
363 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
364 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
365 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
366 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
367 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
368 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
369 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
370 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
371 & 'ETOT= ',1pE16.6,' (total)')
373 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
374 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
375 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
376 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
377 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
378 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
379 & edihcnstr,ehomology_constr,ebr*nss,
380 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet,
382 10 format (/'Virtual-chain energies:'//
383 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
384 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
385 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
386 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
387 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
388 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
389 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
390 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
391 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
392 & ' (SS bridges & dist. cnstr.)'/
393 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
394 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
395 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
396 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
397 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
398 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
399 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
400 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
401 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
402 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
403 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
404 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
405 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
406 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
407 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
408 & 'ETOT= ',1pE16.6,' (total)')
412 C-----------------------------------------------------------------------
413 subroutine elj(evdw,evdw_t)
415 C This subroutine calculates the interaction energy of nonbonded side chains
416 C assuming the LJ potential of interaction.
418 implicit real*8 (a-h,o-z)
420 include 'DIMENSIONS.ZSCOPT'
421 include "DIMENSIONS.COMPAR"
422 parameter (accur=1.0d-10)
425 include 'COMMON.LOCAL'
426 include 'COMMON.CHAIN'
427 include 'COMMON.DERIV'
428 include 'COMMON.INTERACT'
429 include 'COMMON.TORSION'
430 include 'COMMON.ENEPS'
431 include 'COMMON.SBRIDGE'
432 include 'COMMON.NAMES'
433 include 'COMMON.IOUNITS'
434 include 'COMMON.CONTACTS'
438 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
441 eneps_temp(j,i)=0.0d0
455 C Calculate SC interaction energy.
458 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
459 cd & 'iend=',iend(i,iint)
460 do j=istart(i,iint),iend(i,iint)
465 C Change 12/1/95 to calculate four-body interactions
466 rij=xj*xj+yj*yj+zj*zj
468 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
469 eps0ij=eps(itypi,itypj)
471 e1=fac*fac*aa(itypi,itypj)
472 e2=fac*bb(itypi,itypj)
474 ij=icant(itypi,itypj)
475 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
476 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
477 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
478 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
479 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
480 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
481 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
482 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
483 if (bb(itypi,itypj).gt.0.0d0) then
490 C Calculate the components of the gradient in DC and X
492 fac=-rrij*(e1+evdwij)
497 gvdwx(k,i)=gvdwx(k,i)-gg(k)
498 gvdwx(k,j)=gvdwx(k,j)+gg(k)
502 gvdwc(l,k)=gvdwc(l,k)+gg(l)
507 C 12/1/95, revised on 5/20/97
509 C Calculate the contact function. The ith column of the array JCONT will
510 C contain the numbers of atoms that make contacts with the atom I (of numbers
511 C greater than I). The arrays FACONT and GACONT will contain the values of
512 C the contact function and its derivative.
514 C Uncomment next line, if the correlation interactions include EVDW explicitly.
515 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
516 C Uncomment next line, if the correlation interactions are contact function only
517 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
519 sigij=sigma(itypi,itypj)
520 r0ij=rs0(itypi,itypj)
522 C Check whether the SC's are not too far to make a contact.
525 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
526 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
528 if (fcont.gt.0.0D0) then
529 C If the SC-SC distance if close to sigma, apply spline.
530 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
531 cAdam & fcont1,fprimcont1)
532 cAdam fcont1=1.0d0-fcont1
533 cAdam if (fcont1.gt.0.0d0) then
534 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
535 cAdam fcont=fcont*fcont1
537 C Uncomment following 4 lines to have the geometric average of the epsilon0's
538 cga eps0ij=1.0d0/dsqrt(eps0ij)
540 cga gg(k)=gg(k)*eps0ij
542 cga eps0ij=-evdwij*eps0ij
543 C Uncomment for AL's type of SC correlation interactions.
545 num_conti=num_conti+1
547 facont(num_conti,i)=fcont*eps0ij
548 fprimcont=eps0ij*fprimcont/rij
550 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
551 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
552 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
553 C Uncomment following 3 lines for Skolnick's type of SC correlation.
554 gacont(1,num_conti,i)=-fprimcont*xj
555 gacont(2,num_conti,i)=-fprimcont*yj
556 gacont(3,num_conti,i)=-fprimcont*zj
557 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
558 cd write (iout,'(2i3,3f10.5)')
559 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
565 num_cont(i)=num_conti
570 gvdwc(j,i)=expon*gvdwc(j,i)
571 gvdwx(j,i)=expon*gvdwx(j,i)
575 C******************************************************************************
579 C To save time, the factor of EXPON has been extracted from ALL components
580 C of GVDWC and GRADX. Remember to multiply them by this factor before further
583 C******************************************************************************
586 C-----------------------------------------------------------------------------
587 subroutine eljk(evdw,evdw_t)
589 C This subroutine calculates the interaction energy of nonbonded side chains
590 C assuming the LJK potential of interaction.
592 implicit real*8 (a-h,o-z)
594 include 'DIMENSIONS.ZSCOPT'
595 include "DIMENSIONS.COMPAR"
598 include 'COMMON.LOCAL'
599 include 'COMMON.CHAIN'
600 include 'COMMON.DERIV'
601 include 'COMMON.INTERACT'
602 include 'COMMON.ENEPS'
603 include 'COMMON.IOUNITS'
604 include 'COMMON.NAMES'
609 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
612 eneps_temp(j,i)=0.0d0
624 C Calculate SC interaction energy.
627 do j=istart(i,iint),iend(i,iint)
632 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
634 e_augm=augm(itypi,itypj)*fac_augm
637 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
638 fac=r_shift_inv**expon
639 e1=fac*fac*aa(itypi,itypj)
640 e2=fac*bb(itypi,itypj)
642 ij=icant(itypi,itypj)
643 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
644 & /dabs(eps(itypi,itypj))
645 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
646 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
647 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
648 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
649 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
650 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
651 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
652 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
653 if (bb(itypi,itypj).gt.0.0d0) then
660 C Calculate the components of the gradient in DC and X
662 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
667 gvdwx(k,i)=gvdwx(k,i)-gg(k)
668 gvdwx(k,j)=gvdwx(k,j)+gg(k)
672 gvdwc(l,k)=gvdwc(l,k)+gg(l)
682 gvdwc(j,i)=expon*gvdwc(j,i)
683 gvdwx(j,i)=expon*gvdwx(j,i)
689 C-----------------------------------------------------------------------------
690 subroutine ebp(evdw,evdw_t)
692 C This subroutine calculates the interaction energy of nonbonded side chains
693 C assuming the Berne-Pechukas potential of interaction.
695 implicit real*8 (a-h,o-z)
697 include 'DIMENSIONS.ZSCOPT'
698 include "DIMENSIONS.COMPAR"
701 include 'COMMON.LOCAL'
702 include 'COMMON.CHAIN'
703 include 'COMMON.DERIV'
704 include 'COMMON.NAMES'
705 include 'COMMON.INTERACT'
706 include 'COMMON.ENEPS'
707 include 'COMMON.IOUNITS'
708 include 'COMMON.CALC'
710 c double precision rrsave(maxdim)
716 eneps_temp(j,i)=0.0d0
721 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
722 c if (icall.eq.0) then
734 dxi=dc_norm(1,nres+i)
735 dyi=dc_norm(2,nres+i)
736 dzi=dc_norm(3,nres+i)
737 dsci_inv=vbld_inv(i+nres)
739 C Calculate SC interaction energy.
742 do j=istart(i,iint),iend(i,iint)
745 dscj_inv=vbld_inv(j+nres)
746 chi1=chi(itypi,itypj)
747 chi2=chi(itypj,itypi)
754 alf12=0.5D0*(alf1+alf2)
755 C For diagnostics only!!!
768 dxj=dc_norm(1,nres+j)
769 dyj=dc_norm(2,nres+j)
770 dzj=dc_norm(3,nres+j)
771 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
772 cd if (icall.eq.0) then
778 C Calculate the angle-dependent terms of energy & contributions to derivatives.
780 C Calculate whole angle-dependent part of epsilon and contributions
782 fac=(rrij*sigsq)**expon2
783 e1=fac*fac*aa(itypi,itypj)
784 e2=fac*bb(itypi,itypj)
785 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
786 eps2der=evdwij*eps3rt
787 eps3der=evdwij*eps2rt
788 evdwij=evdwij*eps2rt*eps3rt
789 ij=icant(itypi,itypj)
790 aux=eps1*eps2rt**2*eps3rt**2
791 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
792 & /dabs(eps(itypi,itypj))
793 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
794 if (bb(itypi,itypj).gt.0.0d0) then
801 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
802 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
803 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
804 cd & restyp(itypi),i,restyp(itypj),j,
805 cd & epsi,sigm,chi1,chi2,chip1,chip2,
806 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
807 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
810 C Calculate gradient components.
811 e1=e1*eps1*eps2rt**2*eps3rt**2
812 fac=-expon*(e1+evdwij)
815 C Calculate radial part of the gradient
819 C Calculate the angular part of the gradient and sum add the contributions
820 C to the appropriate components of the Cartesian gradient.
829 C-----------------------------------------------------------------------------
830 subroutine egb(evdw,evdw_t)
832 C This subroutine calculates the interaction energy of nonbonded side chains
833 C assuming the Gay-Berne potential of interaction.
835 implicit real*8 (a-h,o-z)
837 include 'DIMENSIONS.ZSCOPT'
838 include "DIMENSIONS.COMPAR"
841 include 'COMMON.LOCAL'
842 include 'COMMON.CHAIN'
843 include 'COMMON.DERIV'
844 include 'COMMON.NAMES'
845 include 'COMMON.INTERACT'
846 include 'COMMON.ENEPS'
847 include 'COMMON.IOUNITS'
848 include 'COMMON.CALC'
849 include 'COMMON.SBRIDGE'
856 eneps_temp(j,i)=0.0d0
859 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
863 c if (icall.gt.0) lprn=.true.
871 dxi=dc_norm(1,nres+i)
872 dyi=dc_norm(2,nres+i)
873 dzi=dc_norm(3,nres+i)
874 dsci_inv=vbld_inv(i+nres)
876 C Calculate SC interaction energy.
879 do j=istart(i,iint),iend(i,iint)
880 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
881 C /06/28/2013 Adasko: In case of dyn_ss - dynamic disulfide bond
882 C formation no electrostatic interactions should be calculated. If it
883 C would be allowed NaN would appear
884 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
885 C /06/28/2013 Adasko: dyn_ss_mask is logical statement wheather this Cys
886 C residue can or cannot form disulfide bond. There is still bug allowing
887 C Cys...Cys...Cys bond formation
888 call dyn_ssbond_ene(i,j,evdwij)
889 C /06/28/2013 Adasko: dyn_ssbond_ene is dynamic SS bond foration energy
892 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
893 c & 'evdw',i,j,evdwij,' ss'
897 dscj_inv=vbld_inv(j+nres)
898 sig0ij=sigma(itypi,itypj)
899 chi1=chi(itypi,itypj)
900 chi2=chi(itypj,itypi)
907 alf12=0.5D0*(alf1+alf2)
908 C For diagnostics only!!!
921 dxj=dc_norm(1,nres+j)
922 dyj=dc_norm(2,nres+j)
923 dzj=dc_norm(3,nres+j)
924 c write (iout,*) i,j,xj,yj,zj
925 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
927 C Calculate angle-dependent terms of energy and contributions to their
931 sig=sig0ij*dsqrt(sigsq)
932 rij_shift=1.0D0/rij-sig+sig0ij
933 C I hate to put IF's in the loops, but here don't have another choice!!!!
934 if (rij_shift.le.0.0D0) then
939 c---------------------------------------------------------------
940 rij_shift=1.0D0/rij_shift
942 e1=fac*fac*aa(itypi,itypj)
943 e2=fac*bb(itypi,itypj)
944 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
945 eps2der=evdwij*eps3rt
946 eps3der=evdwij*eps2rt
947 evdwij=evdwij*eps2rt*eps3rt
948 if (bb(itypi,itypj).gt.0) then
953 ij=icant(itypi,itypj)
954 aux=eps1*eps2rt**2*eps3rt**2
955 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
956 & /dabs(eps(itypi,itypj))
957 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
958 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
959 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
960 c & aux*e2/eps(itypi,itypj)
961 c write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
963 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
964 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
965 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
966 & restyp(itypi),i,restyp(itypj),j,
967 & epsi,sigm,chi1,chi2,chip1,chip2,
968 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
969 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
973 C Calculate gradient components.
974 e1=e1*eps1*eps2rt**2*eps3rt**2
975 fac=-expon*(e1+evdwij)*rij_shift
978 C Calculate the radial part of the gradient
982 C Calculate angular part of the gradient.
991 C-----------------------------------------------------------------------------
992 subroutine egbv(evdw,evdw_t)
994 C This subroutine calculates the interaction energy of nonbonded side chains
995 C assuming the Gay-Berne-Vorobjev potential of interaction.
997 implicit real*8 (a-h,o-z)
999 include 'DIMENSIONS.ZSCOPT'
1000 include "DIMENSIONS.COMPAR"
1001 include 'COMMON.GEO'
1002 include 'COMMON.VAR'
1003 include 'COMMON.LOCAL'
1004 include 'COMMON.CHAIN'
1005 include 'COMMON.DERIV'
1006 include 'COMMON.NAMES'
1007 include 'COMMON.INTERACT'
1008 include 'COMMON.ENEPS'
1009 include 'COMMON.IOUNITS'
1010 include 'COMMON.CALC'
1011 common /srutu/ icall
1017 eneps_temp(j,i)=0.0d0
1022 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1025 c if (icall.gt.0) lprn=.true.
1027 do i=iatsc_s,iatsc_e
1033 dxi=dc_norm(1,nres+i)
1034 dyi=dc_norm(2,nres+i)
1035 dzi=dc_norm(3,nres+i)
1036 dsci_inv=vbld_inv(i+nres)
1038 C Calculate SC interaction energy.
1040 do iint=1,nint_gr(i)
1041 do j=istart(i,iint),iend(i,iint)
1044 dscj_inv=vbld_inv(j+nres)
1045 sig0ij=sigma(itypi,itypj)
1046 r0ij=r0(itypi,itypj)
1047 chi1=chi(itypi,itypj)
1048 chi2=chi(itypj,itypi)
1055 alf12=0.5D0*(alf1+alf2)
1056 C For diagnostics only!!!
1069 dxj=dc_norm(1,nres+j)
1070 dyj=dc_norm(2,nres+j)
1071 dzj=dc_norm(3,nres+j)
1072 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1074 C Calculate angle-dependent terms of energy and contributions to their
1078 sig=sig0ij*dsqrt(sigsq)
1079 rij_shift=1.0D0/rij-sig+r0ij
1080 C I hate to put IF's in the loops, but here don't have another choice!!!!
1081 if (rij_shift.le.0.0D0) then
1086 c---------------------------------------------------------------
1087 rij_shift=1.0D0/rij_shift
1088 fac=rij_shift**expon
1089 e1=fac*fac*aa(itypi,itypj)
1090 e2=fac*bb(itypi,itypj)
1091 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1092 eps2der=evdwij*eps3rt
1093 eps3der=evdwij*eps2rt
1094 fac_augm=rrij**expon
1095 e_augm=augm(itypi,itypj)*fac_augm
1096 evdwij=evdwij*eps2rt*eps3rt
1097 if (bb(itypi,itypj).gt.0.0d0) then
1098 evdw=evdw+evdwij+e_augm
1100 evdw_t=evdw_t+evdwij+e_augm
1102 ij=icant(itypi,itypj)
1103 aux=eps1*eps2rt**2*eps3rt**2
1104 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1105 & /dabs(eps(itypi,itypj))
1106 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1107 c eneps_temp(ij)=eneps_temp(ij)
1108 c & +(evdwij+e_augm)/eps(itypi,itypj)
1110 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1111 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1112 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1113 c & restyp(itypi),i,restyp(itypj),j,
1114 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1115 c & chi1,chi2,chip1,chip2,
1116 c & eps1,eps2rt**2,eps3rt**2,
1117 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1121 C Calculate gradient components.
1122 e1=e1*eps1*eps2rt**2*eps3rt**2
1123 fac=-expon*(e1+evdwij)*rij_shift
1125 fac=rij*fac-2*expon*rrij*e_augm
1126 C Calculate the radial part of the gradient
1130 C Calculate angular part of the gradient.
1138 C-----------------------------------------------------------------------------
1139 subroutine sc_angular
1140 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1141 C om12. Called by ebp, egb, and egbv.
1143 include 'COMMON.CALC'
1147 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1148 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1149 om12=dxi*dxj+dyi*dyj+dzi*dzj
1151 C Calculate eps1(om12) and its derivative in om12
1152 faceps1=1.0D0-om12*chiom12
1153 faceps1_inv=1.0D0/faceps1
1154 eps1=dsqrt(faceps1_inv)
1155 C Following variable is eps1*deps1/dom12
1156 eps1_om12=faceps1_inv*chiom12
1157 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1162 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1163 sigsq=1.0D0-facsig*faceps1_inv
1164 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1165 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1166 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1167 C Calculate eps2 and its derivatives in om1, om2, and om12.
1170 chipom12=chip12*om12
1171 facp=1.0D0-om12*chipom12
1173 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1174 C Following variable is the square root of eps2
1175 eps2rt=1.0D0-facp1*facp_inv
1176 C Following three variables are the derivatives of the square root of eps
1177 C in om1, om2, and om12.
1178 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1179 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1180 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1181 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1182 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1183 C Calculate whole angle-dependent part of epsilon and contributions
1184 C to its derivatives
1187 C----------------------------------------------------------------------------
1189 implicit real*8 (a-h,o-z)
1190 include 'DIMENSIONS'
1191 include 'DIMENSIONS.ZSCOPT'
1192 include 'COMMON.CHAIN'
1193 include 'COMMON.DERIV'
1194 include 'COMMON.CALC'
1195 double precision dcosom1(3),dcosom2(3)
1196 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1197 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1198 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1199 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1201 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1202 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1205 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1208 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1209 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1210 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1211 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1212 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1213 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1216 C Calculate the components of the gradient in DC and X
1220 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1225 c------------------------------------------------------------------------------
1226 subroutine vec_and_deriv
1227 implicit real*8 (a-h,o-z)
1228 include 'DIMENSIONS'
1229 include 'DIMENSIONS.ZSCOPT'
1230 include 'COMMON.IOUNITS'
1231 include 'COMMON.GEO'
1232 include 'COMMON.VAR'
1233 include 'COMMON.LOCAL'
1234 include 'COMMON.CHAIN'
1235 include 'COMMON.VECTORS'
1236 include 'COMMON.DERIV'
1237 include 'COMMON.INTERACT'
1238 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1239 C Compute the local reference systems. For reference system (i), the
1240 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1241 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1243 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1244 if (i.eq.nres-1) then
1245 C Case of the last full residue
1246 C Compute the Z-axis
1247 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1248 costh=dcos(pi-theta(nres))
1249 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1254 C Compute the derivatives of uz
1256 uzder(2,1,1)=-dc_norm(3,i-1)
1257 uzder(3,1,1)= dc_norm(2,i-1)
1258 uzder(1,2,1)= dc_norm(3,i-1)
1260 uzder(3,2,1)=-dc_norm(1,i-1)
1261 uzder(1,3,1)=-dc_norm(2,i-1)
1262 uzder(2,3,1)= dc_norm(1,i-1)
1265 uzder(2,1,2)= dc_norm(3,i)
1266 uzder(3,1,2)=-dc_norm(2,i)
1267 uzder(1,2,2)=-dc_norm(3,i)
1269 uzder(3,2,2)= dc_norm(1,i)
1270 uzder(1,3,2)= dc_norm(2,i)
1271 uzder(2,3,2)=-dc_norm(1,i)
1274 C Compute the Y-axis
1277 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1280 C Compute the derivatives of uy
1283 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1284 & -dc_norm(k,i)*dc_norm(j,i-1)
1285 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1287 uyder(j,j,1)=uyder(j,j,1)-costh
1288 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1293 uygrad(l,k,j,i)=uyder(l,k,j)
1294 uzgrad(l,k,j,i)=uzder(l,k,j)
1298 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1299 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1300 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1301 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1305 C Compute the Z-axis
1306 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1307 costh=dcos(pi-theta(i+2))
1308 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1313 C Compute the derivatives of uz
1315 uzder(2,1,1)=-dc_norm(3,i+1)
1316 uzder(3,1,1)= dc_norm(2,i+1)
1317 uzder(1,2,1)= dc_norm(3,i+1)
1319 uzder(3,2,1)=-dc_norm(1,i+1)
1320 uzder(1,3,1)=-dc_norm(2,i+1)
1321 uzder(2,3,1)= dc_norm(1,i+1)
1324 uzder(2,1,2)= dc_norm(3,i)
1325 uzder(3,1,2)=-dc_norm(2,i)
1326 uzder(1,2,2)=-dc_norm(3,i)
1328 uzder(3,2,2)= dc_norm(1,i)
1329 uzder(1,3,2)= dc_norm(2,i)
1330 uzder(2,3,2)=-dc_norm(1,i)
1333 C Compute the Y-axis
1336 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1339 C Compute the derivatives of uy
1342 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1343 & -dc_norm(k,i)*dc_norm(j,i+1)
1344 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1346 uyder(j,j,1)=uyder(j,j,1)-costh
1347 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1352 uygrad(l,k,j,i)=uyder(l,k,j)
1353 uzgrad(l,k,j,i)=uzder(l,k,j)
1357 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1358 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1359 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1360 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1366 vbld_inv_temp(1)=vbld_inv(i+1)
1367 if (i.lt.nres-1) then
1368 vbld_inv_temp(2)=vbld_inv(i+2)
1370 vbld_inv_temp(2)=vbld_inv(i)
1375 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1376 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1384 C-----------------------------------------------------------------------------
1385 subroutine vec_and_deriv_test
1386 implicit real*8 (a-h,o-z)
1387 include 'DIMENSIONS'
1388 include 'DIMENSIONS.ZSCOPT'
1389 include 'COMMON.IOUNITS'
1390 include 'COMMON.GEO'
1391 include 'COMMON.VAR'
1392 include 'COMMON.LOCAL'
1393 include 'COMMON.CHAIN'
1394 include 'COMMON.VECTORS'
1395 dimension uyder(3,3,2),uzder(3,3,2)
1396 C Compute the local reference systems. For reference system (i), the
1397 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1398 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1400 if (i.eq.nres-1) then
1401 C Case of the last full residue
1402 C Compute the Z-axis
1403 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1404 costh=dcos(pi-theta(nres))
1405 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1406 c write (iout,*) 'fac',fac,
1407 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1408 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1412 C Compute the derivatives of uz
1414 uzder(2,1,1)=-dc_norm(3,i-1)
1415 uzder(3,1,1)= dc_norm(2,i-1)
1416 uzder(1,2,1)= dc_norm(3,i-1)
1418 uzder(3,2,1)=-dc_norm(1,i-1)
1419 uzder(1,3,1)=-dc_norm(2,i-1)
1420 uzder(2,3,1)= dc_norm(1,i-1)
1423 uzder(2,1,2)= dc_norm(3,i)
1424 uzder(3,1,2)=-dc_norm(2,i)
1425 uzder(1,2,2)=-dc_norm(3,i)
1427 uzder(3,2,2)= dc_norm(1,i)
1428 uzder(1,3,2)= dc_norm(2,i)
1429 uzder(2,3,2)=-dc_norm(1,i)
1431 C Compute the Y-axis
1433 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1436 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1437 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1438 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1440 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1443 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1444 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1447 c write (iout,*) 'facy',facy,
1448 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1449 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1451 uy(k,i)=facy*uy(k,i)
1453 C Compute the derivatives of uy
1456 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1457 & -dc_norm(k,i)*dc_norm(j,i-1)
1458 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1460 c uyder(j,j,1)=uyder(j,j,1)-costh
1461 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1462 uyder(j,j,1)=uyder(j,j,1)
1463 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1464 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1470 uygrad(l,k,j,i)=uyder(l,k,j)
1471 uzgrad(l,k,j,i)=uzder(l,k,j)
1475 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1476 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1477 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1478 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1481 C Compute the Z-axis
1482 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1483 costh=dcos(pi-theta(i+2))
1484 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1485 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1489 C Compute the derivatives of uz
1491 uzder(2,1,1)=-dc_norm(3,i+1)
1492 uzder(3,1,1)= dc_norm(2,i+1)
1493 uzder(1,2,1)= dc_norm(3,i+1)
1495 uzder(3,2,1)=-dc_norm(1,i+1)
1496 uzder(1,3,1)=-dc_norm(2,i+1)
1497 uzder(2,3,1)= dc_norm(1,i+1)
1500 uzder(2,1,2)= dc_norm(3,i)
1501 uzder(3,1,2)=-dc_norm(2,i)
1502 uzder(1,2,2)=-dc_norm(3,i)
1504 uzder(3,2,2)= dc_norm(1,i)
1505 uzder(1,3,2)= dc_norm(2,i)
1506 uzder(2,3,2)=-dc_norm(1,i)
1508 C Compute the Y-axis
1510 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1511 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1512 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1514 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1517 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1518 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1521 c write (iout,*) 'facy',facy,
1522 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1523 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1525 uy(k,i)=facy*uy(k,i)
1527 C Compute the derivatives of uy
1530 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1531 & -dc_norm(k,i)*dc_norm(j,i+1)
1532 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1534 c uyder(j,j,1)=uyder(j,j,1)-costh
1535 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1536 uyder(j,j,1)=uyder(j,j,1)
1537 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1538 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1544 uygrad(l,k,j,i)=uyder(l,k,j)
1545 uzgrad(l,k,j,i)=uzder(l,k,j)
1549 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1550 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1551 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1552 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1559 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1560 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1567 C-----------------------------------------------------------------------------
1568 subroutine check_vecgrad
1569 implicit real*8 (a-h,o-z)
1570 include 'DIMENSIONS'
1571 include 'DIMENSIONS.ZSCOPT'
1572 include 'COMMON.IOUNITS'
1573 include 'COMMON.GEO'
1574 include 'COMMON.VAR'
1575 include 'COMMON.LOCAL'
1576 include 'COMMON.CHAIN'
1577 include 'COMMON.VECTORS'
1578 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1579 dimension uyt(3,maxres),uzt(3,maxres)
1580 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1581 double precision delta /1.0d-7/
1584 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1585 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1586 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1587 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1588 cd & (dc_norm(if90,i),if90=1,3)
1589 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1590 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1591 cd write(iout,'(a)')
1597 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1598 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1611 cd write (iout,*) 'i=',i
1613 erij(k)=dc_norm(k,i)
1617 dc_norm(k,i)=erij(k)
1619 dc_norm(j,i)=dc_norm(j,i)+delta
1620 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1622 c dc_norm(k,i)=dc_norm(k,i)/fac
1624 c write (iout,*) (dc_norm(k,i),k=1,3)
1625 c write (iout,*) (erij(k),k=1,3)
1628 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1629 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1630 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1631 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1633 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1634 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1635 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1638 dc_norm(k,i)=erij(k)
1641 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1642 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1643 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1644 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1645 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1646 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1647 cd write (iout,'(a)')
1652 C--------------------------------------------------------------------------
1653 subroutine set_matrices
1654 implicit real*8 (a-h,o-z)
1655 include 'DIMENSIONS'
1656 include 'DIMENSIONS.ZSCOPT'
1657 include 'COMMON.IOUNITS'
1658 include 'COMMON.GEO'
1659 include 'COMMON.VAR'
1660 include 'COMMON.LOCAL'
1661 include 'COMMON.CHAIN'
1662 include 'COMMON.DERIV'
1663 include 'COMMON.INTERACT'
1664 include 'COMMON.CONTACTS'
1665 include 'COMMON.TORSION'
1666 include 'COMMON.VECTORS'
1667 include 'COMMON.FFIELD'
1668 double precision auxvec(2),auxmat(2,2)
1670 C Compute the virtual-bond-torsional-angle dependent quantities needed
1671 C to calculate the el-loc multibody terms of various order.
1674 if (i .lt. nres+1) then
1711 if (i .gt. 3 .and. i .lt. nres+1) then
1712 obrot_der(1,i-2)=-sin1
1713 obrot_der(2,i-2)= cos1
1714 Ugder(1,1,i-2)= sin1
1715 Ugder(1,2,i-2)=-cos1
1716 Ugder(2,1,i-2)=-cos1
1717 Ugder(2,2,i-2)=-sin1
1720 obrot2_der(1,i-2)=-dwasin2
1721 obrot2_der(2,i-2)= dwacos2
1722 Ug2der(1,1,i-2)= dwasin2
1723 Ug2der(1,2,i-2)=-dwacos2
1724 Ug2der(2,1,i-2)=-dwacos2
1725 Ug2der(2,2,i-2)=-dwasin2
1727 obrot_der(1,i-2)=0.0d0
1728 obrot_der(2,i-2)=0.0d0
1729 Ugder(1,1,i-2)=0.0d0
1730 Ugder(1,2,i-2)=0.0d0
1731 Ugder(2,1,i-2)=0.0d0
1732 Ugder(2,2,i-2)=0.0d0
1733 obrot2_der(1,i-2)=0.0d0
1734 obrot2_der(2,i-2)=0.0d0
1735 Ug2der(1,1,i-2)=0.0d0
1736 Ug2der(1,2,i-2)=0.0d0
1737 Ug2der(2,1,i-2)=0.0d0
1738 Ug2der(2,2,i-2)=0.0d0
1740 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1741 iti = itortyp(itype(i-2))
1745 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1746 iti1 = itortyp(itype(i-1))
1750 cd write (iout,*) '*******i',i,' iti1',iti
1751 cd write (iout,*) 'b1',b1(:,iti)
1752 cd write (iout,*) 'b2',b2(:,iti)
1753 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1754 if (i .gt. iatel_s+2) then
1755 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1756 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1757 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1758 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1759 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1760 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1761 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1771 DtUg2(l,k,i-2)=0.0d0
1775 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1776 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1777 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1778 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1779 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1780 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1781 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1783 muder(k,i-2)=Ub2der(k,i-2)
1785 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1786 iti1 = itortyp(itype(i-1))
1791 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1793 C Vectors and matrices dependent on a single virtual-bond dihedral.
1794 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1795 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1796 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1797 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1798 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1799 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1800 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1801 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1802 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1803 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1804 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1806 C Matrices dependent on two consecutive virtual-bond dihedrals.
1807 C The order of matrices is from left to right.
1809 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1810 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1811 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1812 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1813 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1814 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1815 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1816 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1819 cd iti = itortyp(itype(i))
1822 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1823 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1828 C--------------------------------------------------------------------------
1829 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1831 C This subroutine calculates the average interaction energy and its gradient
1832 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1833 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1834 C The potential depends both on the distance of peptide-group centers and on
1835 C the orientation of the CA-CA virtual bonds.
1837 implicit real*8 (a-h,o-z)
1838 include 'DIMENSIONS'
1839 include 'DIMENSIONS.ZSCOPT'
1840 include 'DIMENSIONS.FREE'
1841 include 'COMMON.CONTROL'
1842 include 'COMMON.IOUNITS'
1843 include 'COMMON.GEO'
1844 include 'COMMON.VAR'
1845 include 'COMMON.LOCAL'
1846 include 'COMMON.CHAIN'
1847 include 'COMMON.DERIV'
1848 include 'COMMON.INTERACT'
1849 include 'COMMON.CONTACTS'
1850 include 'COMMON.TORSION'
1851 include 'COMMON.VECTORS'
1852 include 'COMMON.FFIELD'
1853 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1854 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1855 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1856 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1857 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1858 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1859 double precision scal_el /0.5d0/
1861 C 13-go grudnia roku pamietnego...
1862 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1863 & 0.0d0,1.0d0,0.0d0,
1864 & 0.0d0,0.0d0,1.0d0/
1865 cd write(iout,*) 'In EELEC'
1867 cd write(iout,*) 'Type',i
1868 cd write(iout,*) 'B1',B1(:,i)
1869 cd write(iout,*) 'B2',B2(:,i)
1870 cd write(iout,*) 'CC',CC(:,:,i)
1871 cd write(iout,*) 'DD',DD(:,:,i)
1872 cd write(iout,*) 'EE',EE(:,:,i)
1874 cd call check_vecgrad
1876 if (icheckgrad.eq.1) then
1878 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1880 dc_norm(k,i)=dc(k,i)*fac
1882 c write (iout,*) 'i',i,' fac',fac
1885 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1886 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1887 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1888 cd if (wel_loc.gt.0.0d0) then
1889 if (icheckgrad.eq.1) then
1890 call vec_and_deriv_test
1897 cd write (iout,*) 'i=',i
1899 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1902 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1903 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1916 cd print '(a)','Enter EELEC'
1917 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1919 gel_loc_loc(i)=0.0d0
1922 do i=iatel_s,iatel_e
1923 if (itel(i).eq.0) goto 1215
1927 dx_normi=dc_norm(1,i)
1928 dy_normi=dc_norm(2,i)
1929 dz_normi=dc_norm(3,i)
1930 xmedi=c(1,i)+0.5d0*dxi
1931 ymedi=c(2,i)+0.5d0*dyi
1932 zmedi=c(3,i)+0.5d0*dzi
1934 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1935 do j=ielstart(i),ielend(i)
1936 if (itel(j).eq.0) goto 1216
1940 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1941 aaa=app(iteli,itelj)
1942 bbb=bpp(iteli,itelj)
1943 C Diagnostics only!!!
1949 ael6i=ael6(iteli,itelj)
1950 ael3i=ael3(iteli,itelj)
1954 dx_normj=dc_norm(1,j)
1955 dy_normj=dc_norm(2,j)
1956 dz_normj=dc_norm(3,j)
1957 xj=c(1,j)+0.5D0*dxj-xmedi
1958 yj=c(2,j)+0.5D0*dyj-ymedi
1959 zj=c(3,j)+0.5D0*dzj-zmedi
1960 rij=xj*xj+yj*yj+zj*zj
1966 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1967 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1968 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1969 fac=cosa-3.0D0*cosb*cosg
1971 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1972 if (j.eq.i+2) ev1=scal_el*ev1
1977 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1980 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1981 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1982 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1985 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1986 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1987 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1988 cd & xmedi,ymedi,zmedi,xj,yj,zj
1990 C Calculate contributions to the Cartesian gradient.
1993 facvdw=-6*rrmij*(ev1+evdwij)
1994 facel=-3*rrmij*(el1+eesij)
2001 * Radial derivatives. First process both termini of the fragment (i,j)
2008 gelc(k,i)=gelc(k,i)+ghalf
2009 gelc(k,j)=gelc(k,j)+ghalf
2012 * Loop over residues i+1 thru j-1.
2016 gelc(l,k)=gelc(l,k)+ggg(l)
2024 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2025 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2028 * Loop over residues i+1 thru j-1.
2032 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2039 fac=-3*rrmij*(facvdw+facvdw+facel)
2045 * Radial derivatives. First process both termini of the fragment (i,j)
2052 gelc(k,i)=gelc(k,i)+ghalf
2053 gelc(k,j)=gelc(k,j)+ghalf
2056 * Loop over residues i+1 thru j-1.
2060 gelc(l,k)=gelc(l,k)+ggg(l)
2067 ecosa=2.0D0*fac3*fac1+fac4
2070 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2071 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2073 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2074 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2076 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2077 cd & (dcosg(k),k=1,3)
2079 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2083 gelc(k,i)=gelc(k,i)+ghalf
2084 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2085 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2086 gelc(k,j)=gelc(k,j)+ghalf
2087 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2088 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2092 gelc(l,k)=gelc(l,k)+ggg(l)
2097 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2098 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2099 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2101 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2102 C energy of a peptide unit is assumed in the form of a second-order
2103 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2104 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2105 C are computed for EVERY pair of non-contiguous peptide groups.
2107 if (j.lt.nres-1) then
2118 muij(kkk)=mu(k,i)*mu(l,j)
2121 cd write (iout,*) 'EELEC: i',i,' j',j
2122 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2123 cd write(iout,*) 'muij',muij
2124 ury=scalar(uy(1,i),erij)
2125 urz=scalar(uz(1,i),erij)
2126 vry=scalar(uy(1,j),erij)
2127 vrz=scalar(uz(1,j),erij)
2128 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2129 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2130 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2131 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2132 C For diagnostics only
2137 fac=dsqrt(-ael6i)*r3ij
2138 cd write (2,*) 'fac=',fac
2139 C For diagnostics only
2145 cd write (iout,'(4i5,4f10.5)')
2146 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2147 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2148 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2149 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2150 cd write (iout,'(4f10.5)')
2151 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2152 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2153 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2154 cd write (iout,'(2i3,9f10.5/)') i,j,
2155 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2157 C Derivatives of the elements of A in virtual-bond vectors
2158 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2165 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2166 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2167 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2168 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2169 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2170 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2171 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2172 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2173 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2174 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2175 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2176 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2186 C Compute radial contributions to the gradient
2208 C Add the contributions coming from er
2211 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2212 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2213 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2214 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2217 C Derivatives in DC(i)
2218 ghalf1=0.5d0*agg(k,1)
2219 ghalf2=0.5d0*agg(k,2)
2220 ghalf3=0.5d0*agg(k,3)
2221 ghalf4=0.5d0*agg(k,4)
2222 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2223 & -3.0d0*uryg(k,2)*vry)+ghalf1
2224 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2225 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2226 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2227 & -3.0d0*urzg(k,2)*vry)+ghalf3
2228 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2229 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2230 C Derivatives in DC(i+1)
2231 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2232 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2233 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2234 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2235 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2236 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2237 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2238 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2239 C Derivatives in DC(j)
2240 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2241 & -3.0d0*vryg(k,2)*ury)+ghalf1
2242 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2243 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2244 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2245 & -3.0d0*vryg(k,2)*urz)+ghalf3
2246 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2247 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2248 C Derivatives in DC(j+1) or DC(nres-1)
2249 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2250 & -3.0d0*vryg(k,3)*ury)
2251 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2252 & -3.0d0*vrzg(k,3)*ury)
2253 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2254 & -3.0d0*vryg(k,3)*urz)
2255 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2256 & -3.0d0*vrzg(k,3)*urz)
2261 C Derivatives in DC(i+1)
2262 cd aggi1(k,1)=agg(k,1)
2263 cd aggi1(k,2)=agg(k,2)
2264 cd aggi1(k,3)=agg(k,3)
2265 cd aggi1(k,4)=agg(k,4)
2266 C Derivatives in DC(j)
2271 C Derivatives in DC(j+1)
2276 if (j.eq.nres-1 .and. i.lt.j-2) then
2278 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2279 cd aggj1(k,l)=agg(k,l)
2285 C Check the loc-el terms by numerical integration
2295 aggi(k,l)=-aggi(k,l)
2296 aggi1(k,l)=-aggi1(k,l)
2297 aggj(k,l)=-aggj(k,l)
2298 aggj1(k,l)=-aggj1(k,l)
2301 if (j.lt.nres-1) then
2307 aggi(k,l)=-aggi(k,l)
2308 aggi1(k,l)=-aggi1(k,l)
2309 aggj(k,l)=-aggj(k,l)
2310 aggj1(k,l)=-aggj1(k,l)
2321 aggi(k,l)=-aggi(k,l)
2322 aggi1(k,l)=-aggi1(k,l)
2323 aggj(k,l)=-aggj(k,l)
2324 aggj1(k,l)=-aggj1(k,l)
2330 IF (wel_loc.gt.0.0d0) THEN
2331 C Contribution to the local-electrostatic energy coming from the i-j pair
2332 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2334 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2335 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2336 eel_loc=eel_loc+eel_loc_ij
2337 C Partial derivatives in virtual-bond dihedral angles gamma
2340 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2341 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2342 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2343 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2344 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2345 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2346 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2347 cd write(iout,*) 'agg ',agg
2348 cd write(iout,*) 'aggi ',aggi
2349 cd write(iout,*) 'aggi1',aggi1
2350 cd write(iout,*) 'aggj ',aggj
2351 cd write(iout,*) 'aggj1',aggj1
2353 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2355 ggg(l)=agg(l,1)*muij(1)+
2356 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2360 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2363 C Remaining derivatives of eello
2365 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2366 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2367 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2368 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2369 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2370 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2371 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2372 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2376 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2377 C Contributions from turns
2382 call eturn34(i,j,eello_turn3,eello_turn4)
2384 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2385 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2387 C Calculate the contact function. The ith column of the array JCONT will
2388 C contain the numbers of atoms that make contacts with the atom I (of numbers
2389 C greater than I). The arrays FACONT and GACONT will contain the values of
2390 C the contact function and its derivative.
2391 c r0ij=1.02D0*rpp(iteli,itelj)
2392 c r0ij=1.11D0*rpp(iteli,itelj)
2393 r0ij=2.20D0*rpp(iteli,itelj)
2394 c r0ij=1.55D0*rpp(iteli,itelj)
2395 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2396 if (fcont.gt.0.0D0) then
2397 num_conti=num_conti+1
2398 if (num_conti.gt.maxconts) then
2399 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2400 & ' will skip next contacts for this conf.'
2402 jcont_hb(num_conti,i)=j
2403 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2404 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2405 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2407 d_cont(num_conti,i)=rij
2408 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2409 C --- Electrostatic-interaction matrix ---
2410 a_chuj(1,1,num_conti,i)=a22
2411 a_chuj(1,2,num_conti,i)=a23
2412 a_chuj(2,1,num_conti,i)=a32
2413 a_chuj(2,2,num_conti,i)=a33
2414 C --- Gradient of rij
2416 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2419 c a_chuj(1,1,num_conti,i)=-0.61d0
2420 c a_chuj(1,2,num_conti,i)= 0.4d0
2421 c a_chuj(2,1,num_conti,i)= 0.65d0
2422 c a_chuj(2,2,num_conti,i)= 0.50d0
2423 c else if (i.eq.2) then
2424 c a_chuj(1,1,num_conti,i)= 0.0d0
2425 c a_chuj(1,2,num_conti,i)= 0.0d0
2426 c a_chuj(2,1,num_conti,i)= 0.0d0
2427 c a_chuj(2,2,num_conti,i)= 0.0d0
2429 C --- and its gradients
2430 cd write (iout,*) 'i',i,' j',j
2432 cd write (iout,*) 'iii 1 kkk',kkk
2433 cd write (iout,*) agg(kkk,:)
2436 cd write (iout,*) 'iii 2 kkk',kkk
2437 cd write (iout,*) aggi(kkk,:)
2440 cd write (iout,*) 'iii 3 kkk',kkk
2441 cd write (iout,*) aggi1(kkk,:)
2444 cd write (iout,*) 'iii 4 kkk',kkk
2445 cd write (iout,*) aggj(kkk,:)
2448 cd write (iout,*) 'iii 5 kkk',kkk
2449 cd write (iout,*) aggj1(kkk,:)
2456 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2457 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2458 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2459 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2460 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2462 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2468 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2469 C Calculate contact energies
2471 wij=cosa-3.0D0*cosb*cosg
2474 c fac3=dsqrt(-ael6i)/r0ij**3
2475 fac3=dsqrt(-ael6i)*r3ij
2476 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2477 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2479 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2480 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2481 C Diagnostics. Comment out or remove after debugging!
2482 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2483 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2484 c ees0m(num_conti,i)=0.0D0
2486 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2487 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2488 facont_hb(num_conti,i)=fcont
2490 C Angular derivatives of the contact function
2491 ees0pij1=fac3/ees0pij
2492 ees0mij1=fac3/ees0mij
2493 fac3p=-3.0D0*fac3*rrmij
2494 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2495 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2497 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2498 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2499 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2500 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2501 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2502 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2503 ecosap=ecosa1+ecosa2
2504 ecosbp=ecosb1+ecosb2
2505 ecosgp=ecosg1+ecosg2
2506 ecosam=ecosa1-ecosa2
2507 ecosbm=ecosb1-ecosb2
2508 ecosgm=ecosg1-ecosg2
2517 fprimcont=fprimcont/rij
2518 cd facont_hb(num_conti,i)=1.0D0
2519 C Following line is for diagnostics.
2522 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2523 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2526 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2527 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2529 gggp(1)=gggp(1)+ees0pijp*xj
2530 gggp(2)=gggp(2)+ees0pijp*yj
2531 gggp(3)=gggp(3)+ees0pijp*zj
2532 gggm(1)=gggm(1)+ees0mijp*xj
2533 gggm(2)=gggm(2)+ees0mijp*yj
2534 gggm(3)=gggm(3)+ees0mijp*zj
2535 C Derivatives due to the contact function
2536 gacont_hbr(1,num_conti,i)=fprimcont*xj
2537 gacont_hbr(2,num_conti,i)=fprimcont*yj
2538 gacont_hbr(3,num_conti,i)=fprimcont*zj
2540 ghalfp=0.5D0*gggp(k)
2541 ghalfm=0.5D0*gggm(k)
2542 gacontp_hb1(k,num_conti,i)=ghalfp
2543 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2544 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2545 gacontp_hb2(k,num_conti,i)=ghalfp
2546 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2547 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2548 gacontp_hb3(k,num_conti,i)=gggp(k)
2549 gacontm_hb1(k,num_conti,i)=ghalfm
2550 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2551 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2552 gacontm_hb2(k,num_conti,i)=ghalfm
2553 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2554 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2555 gacontm_hb3(k,num_conti,i)=gggm(k)
2558 C Diagnostics. Comment out or remove after debugging!
2560 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2561 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2562 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2563 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2564 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2565 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2568 endif ! num_conti.le.maxconts
2573 num_cont_hb(i)=num_conti
2577 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2578 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2580 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2581 ccc eel_loc=eel_loc+eello_turn3
2584 C-----------------------------------------------------------------------------
2585 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2586 C Third- and fourth-order contributions from turns
2587 implicit real*8 (a-h,o-z)
2588 include 'DIMENSIONS'
2589 include 'DIMENSIONS.ZSCOPT'
2590 include 'COMMON.IOUNITS'
2591 include 'COMMON.GEO'
2592 include 'COMMON.VAR'
2593 include 'COMMON.LOCAL'
2594 include 'COMMON.CHAIN'
2595 include 'COMMON.DERIV'
2596 include 'COMMON.INTERACT'
2597 include 'COMMON.CONTACTS'
2598 include 'COMMON.TORSION'
2599 include 'COMMON.VECTORS'
2600 include 'COMMON.FFIELD'
2602 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2603 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2604 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2605 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2606 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2607 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2609 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2611 C Third-order contributions
2618 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2619 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2620 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2621 call transpose2(auxmat(1,1),auxmat1(1,1))
2622 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2623 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2624 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2625 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2626 cd & ' eello_turn3_num',4*eello_turn3_num
2628 C Derivatives in gamma(i)
2629 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2630 call transpose2(auxmat2(1,1),pizda(1,1))
2631 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2632 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2633 C Derivatives in gamma(i+1)
2634 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2635 call transpose2(auxmat2(1,1),pizda(1,1))
2636 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2637 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2638 & +0.5d0*(pizda(1,1)+pizda(2,2))
2639 C Cartesian derivatives
2641 a_temp(1,1)=aggi(l,1)
2642 a_temp(1,2)=aggi(l,2)
2643 a_temp(2,1)=aggi(l,3)
2644 a_temp(2,2)=aggi(l,4)
2645 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2646 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2647 & +0.5d0*(pizda(1,1)+pizda(2,2))
2648 a_temp(1,1)=aggi1(l,1)
2649 a_temp(1,2)=aggi1(l,2)
2650 a_temp(2,1)=aggi1(l,3)
2651 a_temp(2,2)=aggi1(l,4)
2652 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2653 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2654 & +0.5d0*(pizda(1,1)+pizda(2,2))
2655 a_temp(1,1)=aggj(l,1)
2656 a_temp(1,2)=aggj(l,2)
2657 a_temp(2,1)=aggj(l,3)
2658 a_temp(2,2)=aggj(l,4)
2659 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2660 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2661 & +0.5d0*(pizda(1,1)+pizda(2,2))
2662 a_temp(1,1)=aggj1(l,1)
2663 a_temp(1,2)=aggj1(l,2)
2664 a_temp(2,1)=aggj1(l,3)
2665 a_temp(2,2)=aggj1(l,4)
2666 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2667 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2668 & +0.5d0*(pizda(1,1)+pizda(2,2))
2671 else if (j.eq.i+3) then
2672 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2674 C Fourth-order contributions
2682 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2683 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2684 iti1=itortyp(itype(i+1))
2685 iti2=itortyp(itype(i+2))
2686 iti3=itortyp(itype(i+3))
2687 call transpose2(EUg(1,1,i+1),e1t(1,1))
2688 call transpose2(Eug(1,1,i+2),e2t(1,1))
2689 call transpose2(Eug(1,1,i+3),e3t(1,1))
2690 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2691 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2692 s1=scalar2(b1(1,iti2),auxvec(1))
2693 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2694 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2695 s2=scalar2(b1(1,iti1),auxvec(1))
2696 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2697 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2698 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2699 eello_turn4=eello_turn4-(s1+s2+s3)
2700 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2701 cd & ' eello_turn4_num',8*eello_turn4_num
2702 C Derivatives in gamma(i)
2704 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2705 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2706 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2707 s1=scalar2(b1(1,iti2),auxvec(1))
2708 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2709 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2710 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2711 C Derivatives in gamma(i+1)
2712 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2713 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2714 s2=scalar2(b1(1,iti1),auxvec(1))
2715 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2716 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2717 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2718 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2719 C Derivatives in gamma(i+2)
2720 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2721 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2722 s1=scalar2(b1(1,iti2),auxvec(1))
2723 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2724 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2725 s2=scalar2(b1(1,iti1),auxvec(1))
2726 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2727 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2728 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2729 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2730 C Cartesian derivatives
2731 C Derivatives of this turn contributions in DC(i+2)
2732 if (j.lt.nres-1) then
2734 a_temp(1,1)=agg(l,1)
2735 a_temp(1,2)=agg(l,2)
2736 a_temp(2,1)=agg(l,3)
2737 a_temp(2,2)=agg(l,4)
2738 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2739 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2740 s1=scalar2(b1(1,iti2),auxvec(1))
2741 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2742 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2743 s2=scalar2(b1(1,iti1),auxvec(1))
2744 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2745 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2746 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2748 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2751 C Remaining derivatives of this turn contribution
2753 a_temp(1,1)=aggi(l,1)
2754 a_temp(1,2)=aggi(l,2)
2755 a_temp(2,1)=aggi(l,3)
2756 a_temp(2,2)=aggi(l,4)
2757 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2758 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2759 s1=scalar2(b1(1,iti2),auxvec(1))
2760 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2761 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2762 s2=scalar2(b1(1,iti1),auxvec(1))
2763 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2764 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2765 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2766 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2767 a_temp(1,1)=aggi1(l,1)
2768 a_temp(1,2)=aggi1(l,2)
2769 a_temp(2,1)=aggi1(l,3)
2770 a_temp(2,2)=aggi1(l,4)
2771 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2772 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2773 s1=scalar2(b1(1,iti2),auxvec(1))
2774 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2775 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2776 s2=scalar2(b1(1,iti1),auxvec(1))
2777 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2778 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2779 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2780 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2781 a_temp(1,1)=aggj(l,1)
2782 a_temp(1,2)=aggj(l,2)
2783 a_temp(2,1)=aggj(l,3)
2784 a_temp(2,2)=aggj(l,4)
2785 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2786 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2787 s1=scalar2(b1(1,iti2),auxvec(1))
2788 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2789 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2790 s2=scalar2(b1(1,iti1),auxvec(1))
2791 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2792 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2793 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2794 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2795 a_temp(1,1)=aggj1(l,1)
2796 a_temp(1,2)=aggj1(l,2)
2797 a_temp(2,1)=aggj1(l,3)
2798 a_temp(2,2)=aggj1(l,4)
2799 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2800 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2801 s1=scalar2(b1(1,iti2),auxvec(1))
2802 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2803 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2804 s2=scalar2(b1(1,iti1),auxvec(1))
2805 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2806 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2807 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2808 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2814 C-----------------------------------------------------------------------------
2815 subroutine vecpr(u,v,w)
2816 implicit real*8(a-h,o-z)
2817 dimension u(3),v(3),w(3)
2818 w(1)=u(2)*v(3)-u(3)*v(2)
2819 w(2)=-u(1)*v(3)+u(3)*v(1)
2820 w(3)=u(1)*v(2)-u(2)*v(1)
2823 C-----------------------------------------------------------------------------
2824 subroutine unormderiv(u,ugrad,unorm,ungrad)
2825 C This subroutine computes the derivatives of a normalized vector u, given
2826 C the derivatives computed without normalization conditions, ugrad. Returns
2829 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2830 double precision vec(3)
2831 double precision scalar
2833 c write (2,*) 'ugrad',ugrad
2836 vec(i)=scalar(ugrad(1,i),u(1))
2838 c write (2,*) 'vec',vec
2841 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2844 c write (2,*) 'ungrad',ungrad
2847 C-----------------------------------------------------------------------------
2848 subroutine escp(evdw2,evdw2_14)
2850 C This subroutine calculates the excluded-volume interaction energy between
2851 C peptide-group centers and side chains and its gradient in virtual-bond and
2852 C side-chain vectors.
2854 implicit real*8 (a-h,o-z)
2855 include 'DIMENSIONS'
2856 include 'DIMENSIONS.ZSCOPT'
2857 include 'COMMON.GEO'
2858 include 'COMMON.VAR'
2859 include 'COMMON.LOCAL'
2860 include 'COMMON.CHAIN'
2861 include 'COMMON.DERIV'
2862 include 'COMMON.INTERACT'
2863 include 'COMMON.FFIELD'
2864 include 'COMMON.IOUNITS'
2868 cd print '(a)','Enter ESCP'
2869 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2870 c & ' scal14',scal14
2871 do i=iatscp_s,iatscp_e
2873 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2874 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2875 if (iteli.eq.0) goto 1225
2876 xi=0.5D0*(c(1,i)+c(1,i+1))
2877 yi=0.5D0*(c(2,i)+c(2,i+1))
2878 zi=0.5D0*(c(3,i)+c(3,i+1))
2880 do iint=1,nscp_gr(i)
2882 do j=iscpstart(i,iint),iscpend(i,iint)
2884 C Uncomment following three lines for SC-p interactions
2888 C Uncomment following three lines for Ca-p interactions
2892 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2894 e1=fac*fac*aad(itypj,iteli)
2895 e2=fac*bad(itypj,iteli)
2896 if (iabs(j-i) .le. 2) then
2899 evdw2_14=evdw2_14+e1+e2
2902 c write (iout,*) i,j,evdwij
2906 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2908 fac=-(evdwij+e1)*rrij
2913 cd write (iout,*) 'j<i'
2914 C Uncomment following three lines for SC-p interactions
2916 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2919 cd write (iout,*) 'j>i'
2922 C Uncomment following line for SC-p interactions
2923 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2927 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2931 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2932 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2935 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2945 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2946 gradx_scp(j,i)=expon*gradx_scp(j,i)
2949 C******************************************************************************
2953 C To save time the factor EXPON has been extracted from ALL components
2954 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2957 C******************************************************************************
2960 C--------------------------------------------------------------------------
2961 subroutine edis(ehpb)
2963 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2965 implicit real*8 (a-h,o-z)
2966 include 'DIMENSIONS'
2967 include 'DIMENSIONS.FREE'
2968 include 'COMMON.SBRIDGE'
2969 include 'COMMON.CHAIN'
2970 include 'COMMON.DERIV'
2971 include 'COMMON.VAR'
2972 include 'COMMON.INTERACT'
2973 include 'COMMON.CONTROL'
2974 include 'COMMON.IOUNITS'
2980 C write (iout,*) ,"link_end",link_end,constr_dist
2981 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2982 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
2983 c & " constr_dist",constr_dist
2984 if (link_end.eq.0) return
2985 do i=link_start,link_end
2986 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2987 C CA-CA distance used in regularization of structure.
2990 C iii and jjj point to the residues for which the distance is assigned.
2991 if (ii.gt.nres) then
2998 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2999 c & dhpb(i),dhpb1(i),forcon(i)
3000 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3001 C distance and angle dependent SS bond potential.
3002 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3003 C & iabs(itype(jjj)).eq.1) then
3004 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3005 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
3006 if (.not.dyn_ss .and. i.le.nss) then
3007 C 15/02/13 CC dynamic SSbond - additional check
3008 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3009 & iabs(itype(jjj)).eq.1) then
3010 call ssbond_ene(iii,jjj,eij)
3013 cd write (iout,*) "eij",eij
3014 cd & ' waga=',waga,' fac=',fac
3015 ! else if (ii.gt.nres .and. jj.gt.nres) then
3017 C Calculate the distance between the two points and its difference from the
3020 if (irestr_type(i).eq.11) then
3021 ehpb=ehpb+fordepth(i)!**4.0d0
3022 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3023 fac=fordepth(i)!**4.0d0
3024 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3025 c if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
3026 c & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
3027 c & ehpb,irestr_type(i)
3028 else if (irestr_type(i).eq.10) then
3029 c AL 6//19/2018 cross-link restraints
3030 xdis = 0.5d0*(dd/forcon(i))**2
3031 expdis = dexp(-xdis)
3032 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
3033 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
3034 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
3035 c & " wboltzd",wboltzd
3036 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
3037 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
3038 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
3039 & *expdis/(aux*forcon(i)**2)
3040 c if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
3041 c & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
3042 c & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
3043 else if (irestr_type(i).eq.2) then
3044 c Quartic restraints
3045 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3046 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
3047 c & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
3048 c & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
3049 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3051 c Quadratic restraints
3053 C Get the force constant corresponding to this distance.
3055 C Calculate the contribution to energy.
3056 ehpb=ehpb+0.5d0*waga*rdis*rdis
3057 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
3058 c & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
3059 c & 0.5d0*waga*rdis*rdis,irestr_type(i)
3061 C Evaluate gradient.
3065 c Calculate Cartesian gradient
3067 ggg(j)=fac*(c(j,jj)-c(j,ii))
3069 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3070 C If this is a SC-SC distance, we need to calculate the contributions to the
3071 C Cartesian gradient in the SC vectors (ghpbx).
3074 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3075 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3079 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3080 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3086 C--------------------------------------------------------------------------
3087 subroutine ssbond_ene(i,j,eij)
3089 C Calculate the distance and angle dependent SS-bond potential energy
3090 C using a free-energy function derived based on RHF/6-31G** ab initio
3091 C calculations of diethyl disulfide.
3093 C A. Liwo and U. Kozlowska, 11/24/03
3095 implicit real*8 (a-h,o-z)
3096 include 'DIMENSIONS'
3097 include 'DIMENSIONS.ZSCOPT'
3098 include 'COMMON.SBRIDGE'
3099 include 'COMMON.CHAIN'
3100 include 'COMMON.DERIV'
3101 include 'COMMON.LOCAL'
3102 include 'COMMON.INTERACT'
3103 include 'COMMON.VAR'
3104 include 'COMMON.IOUNITS'
3105 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3110 dxi=dc_norm(1,nres+i)
3111 dyi=dc_norm(2,nres+i)
3112 dzi=dc_norm(3,nres+i)
3113 dsci_inv=dsc_inv(itypi)
3115 dscj_inv=dsc_inv(itypj)
3119 dxj=dc_norm(1,nres+j)
3120 dyj=dc_norm(2,nres+j)
3121 dzj=dc_norm(3,nres+j)
3122 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3127 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3128 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3129 om12=dxi*dxj+dyi*dyj+dzi*dzj
3131 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3132 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3138 deltat12=om2-om1+2.0d0
3140 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3141 & +akct*deltad*deltat12+ebr
3142 c & +akct*deltad*deltat12
3143 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3144 write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3145 & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3146 & " deltat12",deltat12," eij",eij,"ebr",ebr
3147 ed=2*akcm*deltad+akct*deltat12
3149 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3150 eom1=-2*akth*deltat1-pom1-om2*pom2
3151 eom2= 2*akth*deltat2+pom1-om1*pom2
3154 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3157 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3158 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3159 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3160 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3163 C Calculate the components of the gradient in DC and X
3167 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3172 C--------------------------------------------------------------------------
3173 c MODELLER restraint function
3174 subroutine e_modeller(ehomology_constr)
3175 implicit real*8 (a-h,o-z)
3176 include 'DIMENSIONS'
3177 include 'DIMENSIONS.ZSCOPT'
3178 include 'DIMENSIONS.FREE'
3179 integer nnn, i, j, k, ki, irec, l
3180 integer katy, odleglosci, test7
3181 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3182 real*8 distance(max_template),distancek(max_template),
3183 & min_odl,godl(max_template),dih_diff(max_template)
3186 c FP - 30/10/2014 Temporary specifications for homology restraints
3188 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3190 double precision, dimension (maxres) :: guscdiff,usc_diff
3191 double precision, dimension (max_template) ::
3192 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3195 include 'COMMON.SBRIDGE'
3196 include 'COMMON.CHAIN'
3197 include 'COMMON.GEO'
3198 include 'COMMON.DERIV'
3199 include 'COMMON.LOCAL'
3200 include 'COMMON.INTERACT'
3201 include 'COMMON.VAR'
3202 include 'COMMON.IOUNITS'
3203 include 'COMMON.CONTROL'
3204 include 'COMMON.HOMRESTR'
3206 include 'COMMON.SETUP'
3207 include 'COMMON.NAMES'
3210 distancek(i)=9999999.9
3215 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3217 C AL 5/2/14 - Introduce list of restraints
3218 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3220 write(iout,*) "------- dist restrs start -------"
3222 do ii = link_start_homo,link_end_homo
3226 c write (iout,*) "dij(",i,j,") =",dij
3228 do k=1,constr_homology
3229 if(.not.l_homo(k,ii)) then
3233 distance(k)=odl(k,ii)-dij
3234 c write (iout,*) "distance(",k,") =",distance(k)
3236 c For Gaussian-type Urestr
3238 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3239 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3240 c write (iout,*) "distancek(",k,") =",distancek(k)
3241 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3243 c For Lorentzian-type Urestr
3245 if (waga_dist.lt.0.0d0) then
3246 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3247 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3248 & (distance(k)**2+sigma_odlir(k,ii)**2))
3252 c min_odl=minval(distancek)
3253 do kk=1,constr_homology
3254 if(l_homo(kk,ii)) then
3255 min_odl=distancek(kk)
3259 do kk=1,constr_homology
3260 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
3261 & min_odl=distancek(kk)
3263 c write (iout,* )"min_odl",min_odl
3265 write (iout,*) "ij dij",i,j,dij
3266 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3267 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3268 write (iout,* )"min_odl",min_odl
3273 if (waga_dist.ge.0.0d0) then
3279 do k=1,constr_homology
3280 c Nie wiem po co to liczycie jeszcze raz!
3281 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
3282 c & (2*(sigma_odl(i,j,k))**2))
3283 if(.not.l_homo(k,ii)) cycle
3284 if (waga_dist.ge.0.0d0) then
3286 c For Gaussian-type Urestr
3288 godl(k)=dexp(-distancek(k)+min_odl)
3289 odleg2=odleg2+godl(k)
3291 c For Lorentzian-type Urestr
3294 odleg2=odleg2+distancek(k)
3297 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3298 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3299 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3300 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3303 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3304 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3306 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
3307 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
3309 if (waga_dist.ge.0.0d0) then
3311 c For Gaussian-type Urestr
3313 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3315 c For Lorentzian-type Urestr
3318 odleg=odleg+odleg2/constr_homology
3322 c write (iout,*) "odleg",odleg ! sum of -ln-s
3325 c For Gaussian-type Urestr
3327 if (waga_dist.ge.0.0d0) sum_godl=odleg2
3329 do k=1,constr_homology
3330 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3331 c & *waga_dist)+min_odl
3332 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3334 if(.not.l_homo(k,ii)) cycle
3335 if (waga_dist.ge.0.0d0) then
3336 c For Gaussian-type Urestr
3338 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
3340 c For Lorentzian-type Urestr
3343 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
3344 & sigma_odlir(k,ii)**2)**2)
3346 sum_sgodl=sum_sgodl+sgodl
3348 c sgodl2=sgodl2+sgodl
3349 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3350 c write(iout,*) "constr_homology=",constr_homology
3351 c write(iout,*) i, j, k, "TEST K"
3353 if (waga_dist.ge.0.0d0) then
3355 c For Gaussian-type Urestr
3357 grad_odl3=waga_homology(iset)*waga_dist
3358 & *sum_sgodl/(sum_godl*dij)
3360 c For Lorentzian-type Urestr
3363 c Original grad expr modified by analogy w Gaussian-type Urestr grad
3364 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
3365 grad_odl3=-waga_homology(iset)*waga_dist*
3366 & sum_sgodl/(constr_homology*dij)
3369 c grad_odl3=sum_sgodl/(sum_godl*dij)
3372 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3373 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3374 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3376 ccc write(iout,*) godl, sgodl, grad_odl3
3378 c grad_odl=grad_odl+grad_odl3
3381 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3382 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3383 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3384 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3385 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3386 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3387 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3388 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3389 c if (i.eq.25.and.j.eq.27) then
3390 c write(iout,*) "jik",jik,"i",i,"j",j
3391 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
3392 c write(iout,*) "grad_odl3",grad_odl3
3393 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
3394 c write(iout,*) "ggodl",ggodl
3395 c write(iout,*) "ghpbc(",jik,i,")",
3396 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
3401 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3402 ccc & dLOG(odleg2),"-odleg=", -odleg
3404 enddo ! ii-loop for dist
3406 write(iout,*) "------- dist restrs end -------"
3407 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
3408 c & waga_d.eq.1.0d0) call sum_gradient
3410 c Pseudo-energy and gradient from dihedral-angle restraints from
3411 c homology templates
3412 c write (iout,*) "End of distance loop"
3415 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3417 write(iout,*) "------- dih restrs start -------"
3418 do i=idihconstr_start_homo,idihconstr_end_homo
3419 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
3422 do i=idihconstr_start_homo,idihconstr_end_homo
3424 c betai=beta(i,i+1,i+2,i+3)
3426 c write (iout,*) "betai =",betai
3427 do k=1,constr_homology
3428 dih_diff(k)=pinorm(dih(k,i)-betai)
3429 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
3430 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3431 c & -(6.28318-dih_diff(i,k))
3432 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3433 c & 6.28318+dih_diff(i,k)
3435 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
3437 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
3439 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3442 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3445 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
3446 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
3448 write (iout,*) "i",i," betai",betai," kat2",kat2
3449 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3451 if (kat2.le.1.0d-14) cycle
3452 kat=kat-dLOG(kat2/constr_homology)
3453 c write (iout,*) "kat",kat ! sum of -ln-s
3455 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3456 ccc & dLOG(kat2), "-kat=", -kat
3459 c ----------------------------------------------------------------------
3461 c ----------------------------------------------------------------------
3465 do k=1,constr_homology
3467 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
3469 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
3471 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3472 sum_sgdih=sum_sgdih+sgdih
3474 c grad_dih3=sum_sgdih/sum_gdih
3475 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
3477 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3478 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3479 ccc & gloc(nphi+i-3,icg)
3480 gloc(i,icg)=gloc(i,icg)+grad_dih3
3482 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
3484 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3485 ccc & gloc(nphi+i-3,icg)
3487 enddo ! i-loop for dih
3489 write(iout,*) "------- dih restrs end -------"
3492 c Pseudo-energy and gradient for theta angle restraints from
3493 c homology templates
3494 c FP 01/15 - inserted from econstr_local_test.F, loop structure
3498 c For constr_homology reference structures (FP)
3500 c Uconst_back_tot=0.0d0
3503 c Econstr_back legacy
3506 c do i=ithet_start,ithet_end
3509 c do i=loc_start,loc_end
3512 duscdiffx(j,i)=0.0d0
3518 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
3519 c write (iout,*) "waga_theta",waga_theta
3520 if (waga_theta.gt.0.0d0) then
3522 write (iout,*) "usampl",usampl
3523 write(iout,*) "------- theta restrs start -------"
3524 c do i=ithet_start,ithet_end
3525 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
3528 c write (iout,*) "maxres",maxres,"nres",nres
3530 do i=ithet_start,ithet_end
3533 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
3535 c Deviation of theta angles wrt constr_homology ref structures
3537 utheta_i=0.0d0 ! argument of Gaussian for single k
3538 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3539 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
3540 c over residues in a fragment
3541 c write (iout,*) "theta(",i,")=",theta(i)
3542 do k=1,constr_homology
3544 c dtheta_i=theta(j)-thetaref(j,iref)
3545 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
3546 theta_diff(k)=thetatpl(k,i)-theta(i)
3548 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
3549 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
3550 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
3551 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
3552 c Gradient for single Gaussian restraint in subr Econstr_back
3553 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
3556 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
3557 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
3561 c Gradient for multiple Gaussian restraint
3562 sum_gtheta=gutheta_i
3564 do k=1,constr_homology
3565 c New generalized expr for multiple Gaussian from Econstr_back
3566 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
3568 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
3569 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
3572 c Final value of gradient using same var as in Econstr_back
3573 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
3574 & *waga_homology(iset)
3575 c dutheta(i)=sum_sgtheta/sum_gtheta
3577 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
3579 Eval=Eval-dLOG(gutheta_i/constr_homology)
3580 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
3581 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
3582 c Uconst_back=Uconst_back+utheta(i)
3583 enddo ! (i-loop for theta)
3585 write(iout,*) "------- theta restrs end -------"
3589 c Deviation of local SC geometry
3591 c Separation of two i-loops (instructed by AL - 11/3/2014)
3593 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
3594 c write (iout,*) "waga_d",waga_d
3597 write(iout,*) "------- SC restrs start -------"
3598 write (iout,*) "Initial duscdiff,duscdiffx"
3599 do i=loc_start,loc_end
3600 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
3601 & (duscdiffx(jik,i),jik=1,3)
3604 do i=loc_start,loc_end
3605 usc_diff_i=0.0d0 ! argument of Gaussian for single k
3606 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
3607 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
3608 c write(iout,*) "xxtab, yytab, zztab"
3609 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
3610 do k=1,constr_homology
3612 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3613 c Original sign inverted for calc of gradients (s. Econstr_back)
3614 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3615 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3616 c write(iout,*) "dxx, dyy, dzz"
3617 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3619 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
3620 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
3621 c uscdiffk(k)=usc_diff(i)
3622 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
3623 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
3624 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
3625 c & xxref(j),yyref(j),zzref(j)
3630 c Generalized expression for multiple Gaussian acc to that for a single
3631 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
3633 c Original implementation
3634 c sum_guscdiff=guscdiff(i)
3636 c sum_sguscdiff=0.0d0
3637 c do k=1,constr_homology
3638 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
3639 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
3640 c sum_sguscdiff=sum_sguscdiff+sguscdiff
3643 c Implementation of new expressions for gradient (Jan. 2015)
3645 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
3647 do k=1,constr_homology
3649 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
3650 c before. Now the drivatives should be correct
3652 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
3653 c Original sign inverted for calc of gradients (s. Econstr_back)
3654 dyy=-yytpl(k,i)+yytab(i) ! ibid y
3655 dzz=-zztpl(k,i)+zztab(i) ! ibid z
3657 c New implementation
3659 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
3660 & sigma_d(k,i) ! for the grad wrt r'
3661 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
3664 c New implementation
3665 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
3667 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
3668 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
3669 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
3670 duscdiff(jik,i)=duscdiff(jik,i)+
3671 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
3672 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
3673 duscdiffx(jik,i)=duscdiffx(jik,i)+
3674 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
3675 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
3678 write(iout,*) "jik",jik,"i",i
3679 write(iout,*) "dxx, dyy, dzz"
3680 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
3681 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
3682 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
3683 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
3684 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
3685 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
3686 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
3687 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
3688 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
3689 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
3690 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
3691 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
3692 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
3693 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
3694 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
3701 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
3702 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
3704 c write (iout,*) i," uscdiff",uscdiff(i)
3706 c Put together deviations from local geometry
3708 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
3709 c & wfrag_back(3,i,iset)*uscdiff(i)
3710 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
3711 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
3712 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
3713 c Uconst_back=Uconst_back+usc_diff(i)
3715 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
3717 c New implment: multiplied by sum_sguscdiff
3720 enddo ! (i-loop for dscdiff)
3725 write(iout,*) "------- SC restrs end -------"
3726 write (iout,*) "------ After SC loop in e_modeller ------"
3727 do i=loc_start,loc_end
3728 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
3729 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
3731 if (waga_theta.eq.1.0d0) then
3732 write (iout,*) "in e_modeller after SC restr end: dutheta"
3733 do i=ithet_start,ithet_end
3734 write (iout,*) i,dutheta(i)
3737 if (waga_d.eq.1.0d0) then
3738 write (iout,*) "e_modeller after SC loop: duscdiff/x"
3740 write (iout,*) i,(duscdiff(j,i),j=1,3)
3741 write (iout,*) i,(duscdiffx(j,i),j=1,3)
3746 c Total energy from homology restraints
3748 write (iout,*) "odleg",odleg," kat",kat
3749 write (iout,*) "odleg",odleg," kat",kat
3750 write (iout,*) "Eval",Eval," Erot",Erot
3751 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
3752 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
3753 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
3756 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
3758 c ehomology_constr=odleg+kat
3760 c For Lorentzian-type Urestr
3763 if (waga_dist.ge.0.0d0) then
3765 c For Gaussian-type Urestr
3767 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
3768 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3769 ehomology_constr=waga_dist*odleg+waga_angle*kat+
3770 & waga_theta*Eval+waga_d*Erot
3771 c write (iout,*) "ehomology_constr=",ehomology_constr
3774 c For Lorentzian-type Urestr
3776 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
3777 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
3778 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
3779 & waga_theta*Eval+waga_d*Erot
3780 c write (iout,*) "ehomology_constr=",ehomology_constr
3783 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
3784 & "Eval",waga_theta,eval,
3785 & "Erot",waga_d,Erot
3786 write (iout,*) "ehomology_constr",ehomology_constr
3790 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3791 747 format(a12,i4,i4,i4,f8.3,f8.3)
3792 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3793 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3794 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3795 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3797 c-----------------------------------------------------------------------
3798 subroutine ebond(estr)
3800 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3802 implicit real*8 (a-h,o-z)
3803 include 'DIMENSIONS'
3804 include 'DIMENSIONS.ZSCOPT'
3805 include 'DIMENSIONS.FREE'
3806 include 'COMMON.LOCAL'
3807 include 'COMMON.GEO'
3808 include 'COMMON.INTERACT'
3809 include 'COMMON.DERIV'
3810 include 'COMMON.VAR'
3811 include 'COMMON.CHAIN'
3812 include 'COMMON.IOUNITS'
3813 include 'COMMON.NAMES'
3814 include 'COMMON.FFIELD'
3815 include 'COMMON.CONTROL'
3816 double precision u(3),ud(3)
3817 logical :: lprn=.false.
3820 diff = vbld(i)-vbldp0
3821 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3824 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3829 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3836 diff=vbld(i+nres)-vbldsc0(1,iti)
3838 & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3839 & AKSC(1,iti),AKSC(1,iti)*diff*diff
3840 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3842 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3846 diff=vbld(i+nres)-vbldsc0(j,iti)
3847 ud(j)=aksc(j,iti)*diff
3848 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3862 uprod2=uprod2*u(k)*u(k)
3866 usumsqder=usumsqder+ud(j)*uprod2
3869 & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3870 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3871 estr=estr+uprod/usum
3873 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3881 C--------------------------------------------------------------------------
3882 subroutine ebend(etheta)
3884 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3885 C angles gamma and its derivatives in consecutive thetas and gammas.
3887 implicit real*8 (a-h,o-z)
3888 include 'DIMENSIONS'
3889 include 'DIMENSIONS.ZSCOPT'
3890 include 'COMMON.LOCAL'
3891 include 'COMMON.GEO'
3892 include 'COMMON.INTERACT'
3893 include 'COMMON.DERIV'
3894 include 'COMMON.VAR'
3895 include 'COMMON.CHAIN'
3896 include 'COMMON.IOUNITS'
3897 include 'COMMON.NAMES'
3898 include 'COMMON.FFIELD'
3899 common /calcthet/ term1,term2,termm,diffak,ratak,
3900 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3901 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3902 double precision y(2),z(2)
3904 time11=dexp(-2*time)
3907 c write (iout,*) "nres",nres
3908 c write (*,'(a,i2)') 'EBEND ICG=',icg
3909 c write (iout,*) ithet_start,ithet_end
3910 do i=ithet_start,ithet_end
3911 C Zero the energy function and its derivative at 0 or pi.
3912 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3914 c if (i.gt.ithet_start .and.
3915 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3916 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3924 c if (i.lt.nres .and. itel(i).ne.0) then
3936 call proc_proc(phii,icrc)
3937 if (icrc.eq.1) phii=150.0
3951 call proc_proc(phii1,icrc)
3952 if (icrc.eq.1) phii1=150.0
3964 C Calculate the "mean" value of theta from the part of the distribution
3965 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3966 C In following comments this theta will be referred to as t_c.
3967 thet_pred_mean=0.0d0
3971 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3973 c write (iout,*) "thet_pred_mean",thet_pred_mean
3974 dthett=thet_pred_mean*ssd
3975 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3976 c write (iout,*) "thet_pred_mean",thet_pred_mean
3977 C Derivatives of the "mean" values in gamma1 and gamma2.
3978 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3979 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3980 if (theta(i).gt.pi-delta) then
3981 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3983 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3984 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3985 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3987 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3989 else if (theta(i).lt.delta) then
3990 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3991 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3992 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3994 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3995 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3998 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4001 etheta=etheta+ethetai
4002 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4003 c & rad2deg*phii,rad2deg*phii1,ethetai
4004 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4005 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4006 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4009 C Ufff.... We've done all this!!!
4012 C---------------------------------------------------------------------------
4013 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4015 implicit real*8 (a-h,o-z)
4016 include 'DIMENSIONS'
4017 include 'COMMON.LOCAL'
4018 include 'COMMON.IOUNITS'
4019 common /calcthet/ term1,term2,termm,diffak,ratak,
4020 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4021 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4022 C Calculate the contributions to both Gaussian lobes.
4023 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4024 C The "polynomial part" of the "standard deviation" of this part of
4028 sig=sig*thet_pred_mean+polthet(j,it)
4030 C Derivative of the "interior part" of the "standard deviation of the"
4031 C gamma-dependent Gaussian lobe in t_c.
4032 sigtc=3*polthet(3,it)
4034 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4037 C Set the parameters of both Gaussian lobes of the distribution.
4038 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4039 fac=sig*sig+sigc0(it)
4042 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4043 sigsqtc=-4.0D0*sigcsq*sigtc
4044 c print *,i,sig,sigtc,sigsqtc
4045 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4046 sigtc=-sigtc/(fac*fac)
4047 C Following variable is sigma(t_c)**(-2)
4048 sigcsq=sigcsq*sigcsq
4050 sig0inv=1.0D0/sig0i**2
4051 delthec=thetai-thet_pred_mean
4052 delthe0=thetai-theta0i
4053 term1=-0.5D0*sigcsq*delthec*delthec
4054 term2=-0.5D0*sig0inv*delthe0*delthe0
4055 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4056 C NaNs in taking the logarithm. We extract the largest exponent which is added
4057 C to the energy (this being the log of the distribution) at the end of energy
4058 C term evaluation for this virtual-bond angle.
4059 if (term1.gt.term2) then
4061 term2=dexp(term2-termm)
4065 term1=dexp(term1-termm)
4068 C The ratio between the gamma-independent and gamma-dependent lobes of
4069 C the distribution is a Gaussian function of thet_pred_mean too.
4070 diffak=gthet(2,it)-thet_pred_mean
4071 ratak=diffak/gthet(3,it)**2
4072 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4073 C Let's differentiate it in thet_pred_mean NOW.
4075 C Now put together the distribution terms to make complete distribution.
4076 termexp=term1+ak*term2
4077 termpre=sigc+ak*sig0i
4078 C Contribution of the bending energy from this theta is just the -log of
4079 C the sum of the contributions from the two lobes and the pre-exponential
4080 C factor. Simple enough, isn't it?
4081 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4082 C NOW the derivatives!!!
4083 C 6/6/97 Take into account the deformation.
4084 E_theta=(delthec*sigcsq*term1
4085 & +ak*delthe0*sig0inv*term2)/termexp
4086 E_tc=((sigtc+aktc*sig0i)/termpre
4087 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4088 & aktc*term2)/termexp)
4091 c-----------------------------------------------------------------------------
4092 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4093 implicit real*8 (a-h,o-z)
4094 include 'DIMENSIONS'
4095 include 'COMMON.LOCAL'
4096 include 'COMMON.IOUNITS'
4097 common /calcthet/ term1,term2,termm,diffak,ratak,
4098 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4099 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4100 delthec=thetai-thet_pred_mean
4101 delthe0=thetai-theta0i
4102 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4103 t3 = thetai-thet_pred_mean
4107 t14 = t12+t6*sigsqtc
4109 t21 = thetai-theta0i
4115 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4116 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4117 & *(-t12*t9-ak*sig0inv*t27)
4121 C--------------------------------------------------------------------------
4122 subroutine ebend(etheta)
4124 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4125 C angles gamma and its derivatives in consecutive thetas and gammas.
4126 C ab initio-derived potentials from
4127 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4129 implicit real*8 (a-h,o-z)
4130 include 'DIMENSIONS'
4131 include 'DIMENSIONS.ZSCOPT'
4132 include 'DIMENSIONS.FREE'
4133 include 'COMMON.LOCAL'
4134 include 'COMMON.GEO'
4135 include 'COMMON.INTERACT'
4136 include 'COMMON.DERIV'
4137 include 'COMMON.VAR'
4138 include 'COMMON.CHAIN'
4139 include 'COMMON.IOUNITS'
4140 include 'COMMON.NAMES'
4141 include 'COMMON.FFIELD'
4142 include 'COMMON.CONTROL'
4143 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4144 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4145 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4146 & sinph1ph2(maxdouble,maxdouble)
4147 logical lprn /.false./, lprn1 /.false./
4149 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4150 do i=ithet_start,ithet_end
4151 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4152 & (itype(i).eq.ntyp1)) cycle
4156 theti2=0.5d0*theta(i)
4157 ityp2=ithetyp(itype(i-1))
4159 coskt(k)=dcos(k*theti2)
4160 sinkt(k)=dsin(k*theti2)
4162 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4165 if (phii.ne.phii) phii=150.0
4169 ityp1=ithetyp(itype(i-2))
4171 cosph1(k)=dcos(k*phii)
4172 sinph1(k)=dsin(k*phii)
4176 ityp1=ithetyp(itype(i-2))
4182 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4185 if (phii1.ne.phii1) phii1=150.0
4190 ityp3=ithetyp(itype(i))
4192 cosph2(k)=dcos(k*phii1)
4193 sinph2(k)=dsin(k*phii1)
4198 ityp3=ithetyp(itype(i))
4204 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4205 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4207 ethetai=aa0thet(ityp1,ityp2,ityp3)
4210 ccl=cosph1(l)*cosph2(k-l)
4211 ssl=sinph1(l)*sinph2(k-l)
4212 scl=sinph1(l)*cosph2(k-l)
4213 csl=cosph1(l)*sinph2(k-l)
4214 cosph1ph2(l,k)=ccl-ssl
4215 cosph1ph2(k,l)=ccl+ssl
4216 sinph1ph2(l,k)=scl+csl
4217 sinph1ph2(k,l)=scl-csl
4221 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4222 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4223 write (iout,*) "coskt and sinkt"
4225 write (iout,*) k,coskt(k),sinkt(k)
4229 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4230 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4233 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4234 & " ethetai",ethetai
4237 write (iout,*) "cosph and sinph"
4239 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4241 write (iout,*) "cosph1ph2 and sinph2ph2"
4244 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4245 & sinph1ph2(l,k),sinph1ph2(k,l)
4248 write(iout,*) "ethetai",ethetai
4252 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4253 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4254 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4255 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4256 ethetai=ethetai+sinkt(m)*aux
4257 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4258 dephii=dephii+k*sinkt(m)*(
4259 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4260 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4261 dephii1=dephii1+k*sinkt(m)*(
4262 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4263 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4265 & write (iout,*) "m",m," k",k," bbthet",
4266 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4267 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4268 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4269 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4273 & write(iout,*) "ethetai",ethetai
4277 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4278 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4279 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4280 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4281 ethetai=ethetai+sinkt(m)*aux
4282 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4283 dephii=dephii+l*sinkt(m)*(
4284 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4285 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4286 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4287 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4288 dephii1=dephii1+(k-l)*sinkt(m)*(
4289 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4290 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4291 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4292 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4294 write (iout,*) "m",m," k",k," l",l," ffthet",
4295 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4296 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4297 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4298 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4299 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4300 & cosph1ph2(k,l)*sinkt(m),
4301 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4308 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4309 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
4310 & phii1*rad2deg,ethetai
4312 etheta=etheta+ethetai
4314 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4315 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4316 gloc(nphi+i-2,icg)=wang*dethetai
4322 c-----------------------------------------------------------------------------
4323 subroutine esc(escloc)
4324 C Calculate the local energy of a side chain and its derivatives in the
4325 C corresponding virtual-bond valence angles THETA and the spherical angles
4327 implicit real*8 (a-h,o-z)
4328 include 'DIMENSIONS'
4329 include 'DIMENSIONS.ZSCOPT'
4330 include 'COMMON.GEO'
4331 include 'COMMON.LOCAL'
4332 include 'COMMON.VAR'
4333 include 'COMMON.INTERACT'
4334 include 'COMMON.DERIV'
4335 include 'COMMON.CHAIN'
4336 include 'COMMON.IOUNITS'
4337 include 'COMMON.NAMES'
4338 include 'COMMON.FFIELD'
4339 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4340 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4341 common /sccalc/ time11,time12,time112,theti,it,nlobit
4344 c write (iout,'(a)') 'ESC'
4345 do i=loc_start,loc_end
4347 if (it.eq.10) goto 1
4349 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4350 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4351 theti=theta(i+1)-pipol
4355 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4357 if (x(2).gt.pi-delta) then
4361 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4363 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4364 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4366 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4367 & ddersc0(1),dersc(1))
4368 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4369 & ddersc0(3),dersc(3))
4371 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4373 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4374 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4375 & dersc0(2),esclocbi,dersc02)
4376 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4378 call splinthet(x(2),0.5d0*delta,ss,ssd)
4383 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4385 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4386 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4388 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4390 c write (iout,*) escloci
4391 else if (x(2).lt.delta) then
4395 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4397 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4398 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4400 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4401 & ddersc0(1),dersc(1))
4402 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4403 & ddersc0(3),dersc(3))
4405 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4407 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4408 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4409 & dersc0(2),esclocbi,dersc02)
4410 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4415 call splinthet(x(2),0.5d0*delta,ss,ssd)
4417 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4419 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4420 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4422 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4423 c write (iout,*) escloci
4425 call enesc(x,escloci,dersc,ddummy,.false.)
4428 escloc=escloc+escloci
4429 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4431 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4433 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4434 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4439 C---------------------------------------------------------------------------
4440 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4441 implicit real*8 (a-h,o-z)
4442 include 'DIMENSIONS'
4443 include 'COMMON.GEO'
4444 include 'COMMON.LOCAL'
4445 include 'COMMON.IOUNITS'
4446 common /sccalc/ time11,time12,time112,theti,it,nlobit
4447 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4448 double precision contr(maxlob,-1:1)
4450 c write (iout,*) 'it=',it,' nlobit=',nlobit
4454 if (mixed) ddersc(j)=0.0d0
4458 C Because of periodicity of the dependence of the SC energy in omega we have
4459 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4460 C To avoid underflows, first compute & store the exponents.
4468 z(k)=x(k)-censc(k,j,it)
4473 Axk=Axk+gaussc(l,k,j,it)*z(l)
4479 expfac=expfac+Ax(k,j,iii)*z(k)
4487 C As in the case of ebend, we want to avoid underflows in exponentiation and
4488 C subsequent NaNs and INFs in energy calculation.
4489 C Find the largest exponent
4493 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4497 cd print *,'it=',it,' emin=',emin
4499 C Compute the contribution to SC energy and derivatives
4503 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4504 cd print *,'j=',j,' expfac=',expfac
4505 escloc_i=escloc_i+expfac
4507 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4511 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4512 & +gaussc(k,2,j,it))*expfac
4519 dersc(1)=dersc(1)/cos(theti)**2
4520 ddersc(1)=ddersc(1)/cos(theti)**2
4523 escloci=-(dlog(escloc_i)-emin)
4525 dersc(j)=dersc(j)/escloc_i
4529 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4534 C------------------------------------------------------------------------------
4535 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4536 implicit real*8 (a-h,o-z)
4537 include 'DIMENSIONS'
4538 include 'COMMON.GEO'
4539 include 'COMMON.LOCAL'
4540 include 'COMMON.IOUNITS'
4541 common /sccalc/ time11,time12,time112,theti,it,nlobit
4542 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4543 double precision contr(maxlob)
4554 z(k)=x(k)-censc(k,j,it)
4560 Axk=Axk+gaussc(l,k,j,it)*z(l)
4566 expfac=expfac+Ax(k,j)*z(k)
4571 C As in the case of ebend, we want to avoid underflows in exponentiation and
4572 C subsequent NaNs and INFs in energy calculation.
4573 C Find the largest exponent
4576 if (emin.gt.contr(j)) emin=contr(j)
4580 C Compute the contribution to SC energy and derivatives
4584 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4585 escloc_i=escloc_i+expfac
4587 dersc(k)=dersc(k)+Ax(k,j)*expfac
4589 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4590 & +gaussc(1,2,j,it))*expfac
4594 dersc(1)=dersc(1)/cos(theti)**2
4595 dersc12=dersc12/cos(theti)**2
4596 escloci=-(dlog(escloc_i)-emin)
4598 dersc(j)=dersc(j)/escloc_i
4600 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4604 c----------------------------------------------------------------------------------
4605 subroutine esc(escloc)
4606 C Calculate the local energy of a side chain and its derivatives in the
4607 C corresponding virtual-bond valence angles THETA and the spherical angles
4608 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4609 C added by Urszula Kozlowska. 07/11/2007
4611 implicit real*8 (a-h,o-z)
4612 include 'DIMENSIONS'
4613 include 'DIMENSIONS.ZSCOPT'
4614 include 'DIMENSIONS.FREE'
4615 include 'COMMON.GEO'
4616 include 'COMMON.LOCAL'
4617 include 'COMMON.VAR'
4618 include 'COMMON.SCROT'
4619 include 'COMMON.INTERACT'
4620 include 'COMMON.DERIV'
4621 include 'COMMON.CHAIN'
4622 include 'COMMON.IOUNITS'
4623 include 'COMMON.NAMES'
4624 include 'COMMON.FFIELD'
4625 include 'COMMON.CONTROL'
4626 include 'COMMON.VECTORS'
4627 double precision x_prime(3),y_prime(3),z_prime(3)
4628 & , sumene,dsc_i,dp2_i,x(65),
4629 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4630 & de_dxx,de_dyy,de_dzz,de_dt
4631 double precision s1_t,s1_6_t,s2_t,s2_6_t
4633 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4634 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4635 & dt_dCi(3),dt_dCi1(3)
4636 common /sccalc/ time11,time12,time112,theti,it,nlobit
4639 do i=loc_start,loc_end
4640 costtab(i+1) =dcos(theta(i+1))
4641 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4642 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4643 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4644 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4645 cosfac=dsqrt(cosfac2)
4646 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4647 sinfac=dsqrt(sinfac2)
4649 if (it.eq.10) goto 1
4651 C Compute the axes of tghe local cartesian coordinates system; store in
4652 c x_prime, y_prime and z_prime
4659 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4660 C & dc_norm(3,i+nres)
4662 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4663 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4666 z_prime(j) = -uz(j,i-1)
4669 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4670 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4671 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4672 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4673 c & " xy",scalar(x_prime(1),y_prime(1)),
4674 c & " xz",scalar(x_prime(1),z_prime(1)),
4675 c & " yy",scalar(y_prime(1),y_prime(1)),
4676 c & " yz",scalar(y_prime(1),z_prime(1)),
4677 c & " zz",scalar(z_prime(1),z_prime(1))
4679 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4680 C to local coordinate system. Store in xx, yy, zz.
4686 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4687 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4688 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4695 C Compute the energy of the ith side cbain
4697 c write (2,*) "xx",xx," yy",yy," zz",zz
4700 x(j) = sc_parmin(j,it)
4703 Cc diagnostics - remove later
4705 yy1 = dsin(alph(2))*dcos(omeg(2))
4706 zz1 = -dsin(alph(2))*dsin(omeg(2))
4707 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4708 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4710 C," --- ", xx_w,yy_w,zz_w
4713 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4714 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4716 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4717 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4719 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4720 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4721 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4722 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4723 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4725 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4726 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4727 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4728 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4729 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4731 dsc_i = 0.743d0+x(61)
4733 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4734 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4735 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4736 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4737 s1=(1+x(63))/(0.1d0 + dscp1)
4738 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4739 s2=(1+x(65))/(0.1d0 + dscp2)
4740 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4741 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4742 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4743 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4745 c & dscp1,dscp2,sumene
4746 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4747 escloc = escloc + sumene
4748 c write (2,*) "escloc",escloc
4749 if (.not. calc_grad) goto 1
4753 C This section to check the numerical derivatives of the energy of ith side
4754 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4755 C #define DEBUG in the code to turn it on.
4757 write (2,*) "sumene =",sumene
4761 write (2,*) xx,yy,zz
4762 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4763 de_dxx_num=(sumenep-sumene)/aincr
4765 write (2,*) "xx+ sumene from enesc=",sumenep
4768 write (2,*) xx,yy,zz
4769 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4770 de_dyy_num=(sumenep-sumene)/aincr
4772 write (2,*) "yy+ sumene from enesc=",sumenep
4775 write (2,*) xx,yy,zz
4776 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4777 de_dzz_num=(sumenep-sumene)/aincr
4779 write (2,*) "zz+ sumene from enesc=",sumenep
4780 costsave=cost2tab(i+1)
4781 sintsave=sint2tab(i+1)
4782 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4783 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4784 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4785 de_dt_num=(sumenep-sumene)/aincr
4786 write (2,*) " t+ sumene from enesc=",sumenep
4787 cost2tab(i+1)=costsave
4788 sint2tab(i+1)=sintsave
4789 C End of diagnostics section.
4792 C Compute the gradient of esc
4794 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4795 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4796 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4797 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4798 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4799 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4800 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4801 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4802 pom1=(sumene3*sint2tab(i+1)+sumene1)
4803 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4804 pom2=(sumene4*cost2tab(i+1)+sumene2)
4805 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4806 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4807 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4808 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4810 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4811 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4812 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4814 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4815 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4816 & +(pom1+pom2)*pom_dx
4818 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4821 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4822 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4823 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4825 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4826 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4827 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4828 & +x(59)*zz**2 +x(60)*xx*zz
4829 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4830 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4831 & +(pom1-pom2)*pom_dy
4833 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4836 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4837 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4838 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4839 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4840 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4841 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4842 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4843 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4845 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4848 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4849 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4850 & +pom1*pom_dt1+pom2*pom_dt2
4852 write(2,*), "de_dt = ", de_dt,de_dt_num
4856 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4857 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4858 cosfac2xx=cosfac2*xx
4859 sinfac2yy=sinfac2*yy
4861 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4863 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4865 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4866 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4867 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4868 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4869 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4870 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4871 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4872 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4873 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4874 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4878 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4879 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4882 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4883 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4884 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4886 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4887 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4891 dXX_Ctab(k,i)=dXX_Ci(k)
4892 dXX_C1tab(k,i)=dXX_Ci1(k)
4893 dYY_Ctab(k,i)=dYY_Ci(k)
4894 dYY_C1tab(k,i)=dYY_Ci1(k)
4895 dZZ_Ctab(k,i)=dZZ_Ci(k)
4896 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4897 dXX_XYZtab(k,i)=dXX_XYZ(k)
4898 dYY_XYZtab(k,i)=dYY_XYZ(k)
4899 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4903 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4904 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4905 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4906 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4907 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4909 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4910 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4911 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4912 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4913 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4914 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4915 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4916 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4918 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4919 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4921 C to check gradient call subroutine check_grad
4928 c------------------------------------------------------------------------------
4929 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4931 C This procedure calculates two-body contact function g(rij) and its derivative:
4934 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4937 C where x=(rij-r0ij)/delta
4939 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4942 double precision rij,r0ij,eps0ij,fcont,fprimcont
4943 double precision x,x2,x4,delta
4947 if (x.lt.-1.0D0) then
4950 else if (x.le.1.0D0) then
4953 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4954 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4961 c------------------------------------------------------------------------------
4962 subroutine splinthet(theti,delta,ss,ssder)
4963 implicit real*8 (a-h,o-z)
4964 include 'DIMENSIONS'
4965 include 'DIMENSIONS.ZSCOPT'
4966 include 'COMMON.VAR'
4967 include 'COMMON.GEO'
4970 if (theti.gt.pipol) then
4971 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4973 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4978 c------------------------------------------------------------------------------
4979 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4981 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4982 double precision ksi,ksi2,ksi3,a1,a2,a3
4983 a1=fprim0*delta/(f1-f0)
4989 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4990 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4993 c------------------------------------------------------------------------------
4994 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4996 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4997 double precision ksi,ksi2,ksi3,a1,a2,a3
5002 a2=3*(f1x-f0x)-2*fprim0x*delta
5003 a3=fprim0x*delta-2*(f1x-f0x)
5004 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5007 C-----------------------------------------------------------------------------
5009 C-----------------------------------------------------------------------------
5010 subroutine etor(etors,edihcnstr,fact)
5011 implicit real*8 (a-h,o-z)
5012 include 'DIMENSIONS'
5013 include 'DIMENSIONS.ZSCOPT'
5014 include 'COMMON.VAR'
5015 include 'COMMON.GEO'
5016 include 'COMMON.LOCAL'
5017 include 'COMMON.TORSION'
5018 include 'COMMON.INTERACT'
5019 include 'COMMON.DERIV'
5020 include 'COMMON.CHAIN'
5021 include 'COMMON.NAMES'
5022 include 'COMMON.IOUNITS'
5023 include 'COMMON.FFIELD'
5024 include 'COMMON.TORCNSTR'
5026 C Set lprn=.true. for debugging
5030 do i=iphi_start,iphi_end
5031 itori=itortyp(itype(i-2))
5032 itori1=itortyp(itype(i-1))
5035 C Proline-Proline pair is a special case...
5036 if (itori.eq.3 .and. itori1.eq.3) then
5037 if (phii.gt.-dwapi3) then
5039 fac=1.0D0/(1.0D0-cosphi)
5040 etorsi=v1(1,3,3)*fac
5041 etorsi=etorsi+etorsi
5042 etors=etors+etorsi-v1(1,3,3)
5043 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5046 v1ij=v1(j+1,itori,itori1)
5047 v2ij=v2(j+1,itori,itori1)
5050 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5051 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5055 v1ij=v1(j,itori,itori1)
5056 v2ij=v2(j,itori,itori1)
5059 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5060 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5064 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5065 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5066 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5067 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5068 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5070 ! 6/20/98 - dihedral angle constraints
5073 itori=idih_constr(i)
5076 if (difi.gt.drange(i)) then
5078 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5079 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5080 else if (difi.lt.-drange(i)) then
5082 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5083 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5085 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5086 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5088 ! write (iout,*) 'edihcnstr',edihcnstr
5091 c------------------------------------------------------------------------------
5093 subroutine etor(etors,edihcnstr,fact)
5094 implicit real*8 (a-h,o-z)
5095 include 'DIMENSIONS'
5096 include 'DIMENSIONS.ZSCOPT'
5097 include 'COMMON.VAR'
5098 include 'COMMON.GEO'
5099 include 'COMMON.LOCAL'
5100 include 'COMMON.TORSION'
5101 include 'COMMON.INTERACT'
5102 include 'COMMON.DERIV'
5103 include 'COMMON.CHAIN'
5104 include 'COMMON.NAMES'
5105 include 'COMMON.IOUNITS'
5106 include 'COMMON.FFIELD'
5107 include 'COMMON.TORCNSTR'
5109 C Set lprn=.true. for debugging
5113 do i=iphi_start,iphi_end
5114 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5115 itori=itortyp(itype(i-2))
5116 itori1=itortyp(itype(i-1))
5119 C Regular cosine and sine terms
5120 do j=1,nterm(itori,itori1)
5121 v1ij=v1(j,itori,itori1)
5122 v2ij=v2(j,itori,itori1)
5125 etors=etors+v1ij*cosphi+v2ij*sinphi
5126 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5130 C E = SUM ----------------------------------- - v1
5131 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5133 cosphi=dcos(0.5d0*phii)
5134 sinphi=dsin(0.5d0*phii)
5135 do j=1,nlor(itori,itori1)
5136 vl1ij=vlor1(j,itori,itori1)
5137 vl2ij=vlor2(j,itori,itori1)
5138 vl3ij=vlor3(j,itori,itori1)
5139 pom=vl2ij*cosphi+vl3ij*sinphi
5140 pom1=1.0d0/(pom*pom+1.0d0)
5141 etors=etors+vl1ij*pom1
5143 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5145 C Subtract the constant term
5146 etors=etors-v0(itori,itori1)
5148 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5149 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5150 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5151 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5152 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5155 ! 6/20/98 - dihedral angle constraints
5158 itori=idih_constr(i)
5160 difi=pinorm(phii-phi0(i))
5162 if (difi.gt.drange(i)) then
5164 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5165 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5166 edihi=0.25d0*ftors*difi**4
5167 else if (difi.lt.-drange(i)) then
5169 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5170 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5171 edihi=0.25d0*ftors*difi**4
5175 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5177 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5178 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5180 ! write (iout,*) 'edihcnstr',edihcnstr
5183 c----------------------------------------------------------------------------
5184 subroutine etor_d(etors_d,fact2)
5185 C 6/23/01 Compute double torsional energy
5186 implicit real*8 (a-h,o-z)
5187 include 'DIMENSIONS'
5188 include 'DIMENSIONS.ZSCOPT'
5189 include 'COMMON.VAR'
5190 include 'COMMON.GEO'
5191 include 'COMMON.LOCAL'
5192 include 'COMMON.TORSION'
5193 include 'COMMON.INTERACT'
5194 include 'COMMON.DERIV'
5195 include 'COMMON.CHAIN'
5196 include 'COMMON.NAMES'
5197 include 'COMMON.IOUNITS'
5198 include 'COMMON.FFIELD'
5199 include 'COMMON.TORCNSTR'
5201 C Set lprn=.true. for debugging
5205 do i=iphi_start,iphi_end-1
5206 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5208 itori=itortyp(itype(i-2))
5209 itori1=itortyp(itype(i-1))
5210 itori2=itortyp(itype(i))
5215 C Regular cosine and sine terms
5216 do j=1,ntermd_1(itori,itori1,itori2)
5217 v1cij=v1c(1,j,itori,itori1,itori2)
5218 v1sij=v1s(1,j,itori,itori1,itori2)
5219 v2cij=v1c(2,j,itori,itori1,itori2)
5220 v2sij=v1s(2,j,itori,itori1,itori2)
5221 cosphi1=dcos(j*phii)
5222 sinphi1=dsin(j*phii)
5223 cosphi2=dcos(j*phii1)
5224 sinphi2=dsin(j*phii1)
5225 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5226 & v2cij*cosphi2+v2sij*sinphi2
5227 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5228 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5230 do k=2,ntermd_2(itori,itori1,itori2)
5232 v1cdij = v2c(k,l,itori,itori1,itori2)
5233 v2cdij = v2c(l,k,itori,itori1,itori2)
5234 v1sdij = v2s(k,l,itori,itori1,itori2)
5235 v2sdij = v2s(l,k,itori,itori1,itori2)
5236 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5237 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5238 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5239 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5240 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5241 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5242 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5243 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5244 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5245 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5248 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5249 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5255 c------------------------------------------------------------------------------
5256 subroutine eback_sc_corr(esccor)
5257 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5258 c conformational states; temporarily implemented as differences
5259 c between UNRES torsional potentials (dependent on three types of
5260 c residues) and the torsional potentials dependent on all 20 types
5261 c of residues computed from AM1 energy surfaces of terminally-blocked
5262 c amino-acid residues.
5263 implicit real*8 (a-h,o-z)
5264 include 'DIMENSIONS'
5265 include 'DIMENSIONS.ZSCOPT'
5266 include 'DIMENSIONS.FREE'
5267 include 'COMMON.VAR'
5268 include 'COMMON.GEO'
5269 include 'COMMON.LOCAL'
5270 include 'COMMON.TORSION'
5271 include 'COMMON.SCCOR'
5272 include 'COMMON.INTERACT'
5273 include 'COMMON.DERIV'
5274 include 'COMMON.CHAIN'
5275 include 'COMMON.NAMES'
5276 include 'COMMON.IOUNITS'
5277 include 'COMMON.FFIELD'
5278 include 'COMMON.CONTROL'
5280 C Set lprn=.true. for debugging
5283 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
5285 do i=itau_start,itau_end
5287 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5288 isccori=isccortyp(itype(i-2))
5289 isccori1=isccortyp(itype(i-1))
5291 cccc Added 9 May 2012
5292 cc Tauangle is torsional engle depending on the value of first digit
5293 c(see comment below)
5294 cc Omicron is flat angle depending on the value of first digit
5295 c(see comment below)
5298 do intertyp=1,3 !intertyp
5299 cc Added 09 May 2012 (Adasko)
5300 cc Intertyp means interaction type of backbone mainchain correlation:
5301 c 1 = SC...Ca...Ca...Ca
5302 c 2 = Ca...Ca...Ca...SC
5303 c 3 = SC...Ca...Ca...SCi
5305 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5306 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5307 & (itype(i-1).eq.21)))
5308 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5309 & .or.(itype(i-2).eq.21)))
5310 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5311 & (itype(i-1).eq.21)))) cycle
5312 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5313 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5315 do j=1,nterm_sccor(isccori,isccori1)
5316 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5317 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5318 cosphi=dcos(j*tauangle(intertyp,i))
5319 sinphi=dsin(j*tauangle(intertyp,i))
5320 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5322 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5324 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5326 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5327 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5328 c &gloc_sc(intertyp,i-3,icg)
5330 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5331 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5332 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5333 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5334 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5337 write (iout,*) "i",i,(tauangle(j,i),j=1,3),esccor_ii
5341 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
5345 c------------------------------------------------------------------------------
5346 subroutine multibody(ecorr)
5347 C This subroutine calculates multi-body contributions to energy following
5348 C the idea of Skolnick et al. If side chains I and J make a contact and
5349 C at the same time side chains I+1 and J+1 make a contact, an extra
5350 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5351 implicit real*8 (a-h,o-z)
5352 include 'DIMENSIONS'
5353 include 'COMMON.IOUNITS'
5354 include 'COMMON.DERIV'
5355 include 'COMMON.INTERACT'
5356 include 'COMMON.CONTACTS'
5357 double precision gx(3),gx1(3)
5360 C Set lprn=.true. for debugging
5364 write (iout,'(a)') 'Contact function values:'
5366 write (iout,'(i2,20(1x,i2,f10.5))')
5367 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5382 num_conti=num_cont(i)
5383 num_conti1=num_cont(i1)
5388 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5389 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5390 cd & ' ishift=',ishift
5391 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5392 C The system gains extra energy.
5393 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5394 endif ! j1==j+-ishift
5403 c------------------------------------------------------------------------------
5404 double precision function esccorr(i,j,k,l,jj,kk)
5405 implicit real*8 (a-h,o-z)
5406 include 'DIMENSIONS'
5407 include 'COMMON.IOUNITS'
5408 include 'COMMON.DERIV'
5409 include 'COMMON.INTERACT'
5410 include 'COMMON.CONTACTS'
5411 double precision gx(3),gx1(3)
5416 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5417 C Calculate the multi-body contribution to energy.
5418 C Calculate multi-body contributions to the gradient.
5419 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5420 cd & k,l,(gacont(m,kk,k),m=1,3)
5422 gx(m) =ekl*gacont(m,jj,i)
5423 gx1(m)=eij*gacont(m,kk,k)
5424 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5425 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5426 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5427 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5431 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5436 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5442 c------------------------------------------------------------------------------
5444 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5445 implicit real*8 (a-h,o-z)
5446 include 'DIMENSIONS'
5447 integer dimen1,dimen2,atom,indx
5448 double precision buffer(dimen1,dimen2)
5449 double precision zapas
5450 common /contacts_hb/ zapas(3,20,maxres,7),
5451 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5452 & num_cont_hb(maxres),jcont_hb(20,maxres)
5453 num_kont=num_cont_hb(atom)
5457 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5460 buffer(i,indx+22)=facont_hb(i,atom)
5461 buffer(i,indx+23)=ees0p(i,atom)
5462 buffer(i,indx+24)=ees0m(i,atom)
5463 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5465 buffer(1,indx+26)=dfloat(num_kont)
5468 c------------------------------------------------------------------------------
5469 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5470 implicit real*8 (a-h,o-z)
5471 include 'DIMENSIONS'
5472 integer dimen1,dimen2,atom,indx
5473 double precision buffer(dimen1,dimen2)
5474 double precision zapas
5475 common /contacts_hb/ zapas(3,20,maxres,7),
5476 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5477 & num_cont_hb(maxres),jcont_hb(20,maxres)
5478 num_kont=buffer(1,indx+26)
5479 num_kont_old=num_cont_hb(atom)
5480 num_cont_hb(atom)=num_kont+num_kont_old
5485 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5488 facont_hb(ii,atom)=buffer(i,indx+22)
5489 ees0p(ii,atom)=buffer(i,indx+23)
5490 ees0m(ii,atom)=buffer(i,indx+24)
5491 jcont_hb(ii,atom)=buffer(i,indx+25)
5495 c------------------------------------------------------------------------------
5497 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5498 C This subroutine calculates multi-body contributions to hydrogen-bonding
5499 implicit real*8 (a-h,o-z)
5500 include 'DIMENSIONS'
5501 include 'DIMENSIONS.ZSCOPT'
5502 include 'COMMON.IOUNITS'
5504 include 'COMMON.INFO'
5506 include 'COMMON.FFIELD'
5507 include 'COMMON.DERIV'
5508 include 'COMMON.INTERACT'
5509 include 'COMMON.CONTACTS'
5511 parameter (max_cont=maxconts)
5512 parameter (max_dim=2*(8*3+2))
5513 parameter (msglen1=max_cont*max_dim*4)
5514 parameter (msglen2=2*msglen1)
5515 integer source,CorrelType,CorrelID,Error
5516 double precision buffer(max_cont,max_dim)
5518 double precision gx(3),gx1(3)
5521 C Set lprn=.true. for debugging
5526 if (fgProcs.le.1) goto 30
5528 write (iout,'(a)') 'Contact function values:'
5530 write (iout,'(2i3,50(1x,i2,f5.2))')
5531 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5532 & j=1,num_cont_hb(i))
5535 C Caution! Following code assumes that electrostatic interactions concerning
5536 C a given atom are split among at most two processors!
5546 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5549 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5550 if (MyRank.gt.0) then
5551 C Send correlation contributions to the preceding processor
5553 nn=num_cont_hb(iatel_s)
5554 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5555 cd write (iout,*) 'The BUFFER array:'
5557 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5559 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5561 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5562 C Clear the contacts of the atom passed to the neighboring processor
5563 nn=num_cont_hb(iatel_s+1)
5565 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5567 num_cont_hb(iatel_s)=0
5569 cd write (iout,*) 'Processor ',MyID,MyRank,
5570 cd & ' is sending correlation contribution to processor',MyID-1,
5571 cd & ' msglen=',msglen
5572 cd write (*,*) 'Processor ',MyID,MyRank,
5573 cd & ' is sending correlation contribution to processor',MyID-1,
5574 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5575 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5576 cd write (iout,*) 'Processor ',MyID,
5577 cd & ' has sent correlation contribution to processor',MyID-1,
5578 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5579 cd write (*,*) 'Processor ',MyID,
5580 cd & ' has sent correlation contribution to processor',MyID-1,
5581 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5583 endif ! (MyRank.gt.0)
5587 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5588 if (MyRank.lt.fgProcs-1) then
5589 C Receive correlation contributions from the next processor
5591 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5592 cd write (iout,*) 'Processor',MyID,
5593 cd & ' is receiving correlation contribution from processor',MyID+1,
5594 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5595 cd write (*,*) 'Processor',MyID,
5596 cd & ' is receiving correlation contribution from processor',MyID+1,
5597 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5599 do while (nbytes.le.0)
5600 call mp_probe(MyID+1,CorrelType,nbytes)
5602 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5603 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5604 cd write (iout,*) 'Processor',MyID,
5605 cd & ' has received correlation contribution from processor',MyID+1,
5606 cd & ' msglen=',msglen,' nbytes=',nbytes
5607 cd write (iout,*) 'The received BUFFER array:'
5609 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5611 if (msglen.eq.msglen1) then
5612 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5613 else if (msglen.eq.msglen2) then
5614 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5615 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5618 & 'ERROR!!!! message length changed while processing correlations.'
5620 & 'ERROR!!!! message length changed while processing correlations.'
5621 call mp_stopall(Error)
5622 endif ! msglen.eq.msglen1
5623 endif ! MyRank.lt.fgProcs-1
5630 write (iout,'(a)') 'Contact function values:'
5632 write (iout,'(2i3,50(1x,i2,f5.2))')
5633 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5634 & j=1,num_cont_hb(i))
5638 C Remove the loop below after debugging !!!
5645 C Calculate the local-electrostatic correlation terms
5646 do i=iatel_s,iatel_e+1
5648 num_conti=num_cont_hb(i)
5649 num_conti1=num_cont_hb(i+1)
5654 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5655 c & ' jj=',jj,' kk=',kk
5656 if (j1.eq.j+1 .or. j1.eq.j-1) then
5657 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5658 C The system gains extra energy.
5659 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5661 write (iout,*) "ecorr",i,j,i+1,j1,
5662 & ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5665 else if (j1.eq.j) then
5666 C Contacts I-J and I-(J+1) occur simultaneously.
5667 C The system loses extra energy.
5668 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5673 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5674 c & ' jj=',jj,' kk=',kk
5676 C Contacts I-J and (I+1)-J occur simultaneously.
5677 C The system loses extra energy.
5678 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5685 c------------------------------------------------------------------------------
5686 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5688 C This subroutine calculates multi-body contributions to hydrogen-bonding
5689 implicit real*8 (a-h,o-z)
5690 include 'DIMENSIONS'
5691 include 'DIMENSIONS.ZSCOPT'
5692 include 'COMMON.IOUNITS'
5694 include 'COMMON.INFO'
5696 include 'COMMON.FFIELD'
5697 include 'COMMON.DERIV'
5698 include 'COMMON.INTERACT'
5699 include 'COMMON.CONTACTS'
5701 parameter (max_cont=maxconts)
5702 parameter (max_dim=2*(8*3+2))
5703 parameter (msglen1=max_cont*max_dim*4)
5704 parameter (msglen2=2*msglen1)
5705 integer source,CorrelType,CorrelID,Error
5706 double precision buffer(max_cont,max_dim)
5708 double precision gx(3),gx1(3)
5711 C Set lprn=.true. for debugging
5717 if (fgProcs.le.1) goto 30
5719 write (iout,'(a)') 'Contact function values:'
5721 write (iout,'(2i3,50(1x,i2,f5.2))')
5722 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5723 & j=1,num_cont_hb(i))
5726 C Caution! Following code assumes that electrostatic interactions concerning
5727 C a given atom are split among at most two processors!
5737 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5740 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5741 if (MyRank.gt.0) then
5742 C Send correlation contributions to the preceding processor
5744 nn=num_cont_hb(iatel_s)
5745 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5746 cd write (iout,*) 'The BUFFER array:'
5748 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5750 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5752 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5753 C Clear the contacts of the atom passed to the neighboring processor
5754 nn=num_cont_hb(iatel_s+1)
5756 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5758 num_cont_hb(iatel_s)=0
5760 cd write (iout,*) 'Processor ',MyID,MyRank,
5761 cd & ' is sending correlation contribution to processor',MyID-1,
5762 cd & ' msglen=',msglen
5763 cd write (*,*) 'Processor ',MyID,MyRank,
5764 cd & ' is sending correlation contribution to processor',MyID-1,
5765 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5766 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5767 cd write (iout,*) 'Processor ',MyID,
5768 cd & ' has sent correlation contribution to processor',MyID-1,
5769 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5770 cd write (*,*) 'Processor ',MyID,
5771 cd & ' has sent correlation contribution to processor',MyID-1,
5772 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5774 endif ! (MyRank.gt.0)
5778 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5779 if (MyRank.lt.fgProcs-1) then
5780 C Receive correlation contributions from the next processor
5782 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5783 cd write (iout,*) 'Processor',MyID,
5784 cd & ' is receiving correlation contribution from processor',MyID+1,
5785 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5786 cd write (*,*) 'Processor',MyID,
5787 cd & ' is receiving correlation contribution from processor',MyID+1,
5788 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5790 do while (nbytes.le.0)
5791 call mp_probe(MyID+1,CorrelType,nbytes)
5793 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5794 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5795 cd write (iout,*) 'Processor',MyID,
5796 cd & ' has received correlation contribution from processor',MyID+1,
5797 cd & ' msglen=',msglen,' nbytes=',nbytes
5798 cd write (iout,*) 'The received BUFFER array:'
5800 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5802 if (msglen.eq.msglen1) then
5803 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5804 else if (msglen.eq.msglen2) then
5805 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5806 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5809 & 'ERROR!!!! message length changed while processing correlations.'
5811 & 'ERROR!!!! message length changed while processing correlations.'
5812 call mp_stopall(Error)
5813 endif ! msglen.eq.msglen1
5814 endif ! MyRank.lt.fgProcs-1
5821 write (iout,'(a)') 'Contact function values:'
5823 write (iout,'(2i3,50(1x,i2,f5.2))')
5824 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5825 & j=1,num_cont_hb(i))
5831 C Remove the loop below after debugging !!!
5838 C Calculate the dipole-dipole interaction energies
5839 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5840 do i=iatel_s,iatel_e+1
5841 num_conti=num_cont_hb(i)
5848 C Calculate the local-electrostatic correlation terms
5849 do i=iatel_s,iatel_e+1
5851 num_conti=num_cont_hb(i)
5852 num_conti1=num_cont_hb(i+1)
5857 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5858 c & ' jj=',jj,' kk=',kk
5859 if (j1.eq.j+1 .or. j1.eq.j-1) then
5860 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5861 C The system gains extra energy.
5863 sqd1=dsqrt(d_cont(jj,i))
5864 sqd2=dsqrt(d_cont(kk,i1))
5865 sred_geom = sqd1*sqd2
5866 IF (sred_geom.lt.cutoff_corr) THEN
5867 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5869 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5870 c & ' jj=',jj,' kk=',kk
5871 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5872 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5874 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5875 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5878 cd write (iout,*) 'sred_geom=',sred_geom,
5879 cd & ' ekont=',ekont,' fprim=',fprimcont
5880 call calc_eello(i,j,i+1,j1,jj,kk)
5881 if (wcorr4.gt.0.0d0)
5882 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5883 if (wcorr5.gt.0.0d0)
5884 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5885 c print *,"wcorr5",ecorr5
5886 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5887 cd write(2,*)'ijkl',i,j,i+1,j1
5888 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5889 & .or. wturn6.eq.0.0d0))then
5890 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5891 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5892 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5893 cd & 'ecorr6=',ecorr6
5894 cd write (iout,'(4e15.5)') sred_geom,
5895 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5896 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5897 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5898 else if (wturn6.gt.0.0d0
5899 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5900 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5901 eturn6=eturn6+eello_turn6(i,jj,kk)
5902 cd write (2,*) 'multibody_eello:eturn6',eturn6
5906 else if (j1.eq.j) then
5907 C Contacts I-J and I-(J+1) occur simultaneously.
5908 C The system loses extra energy.
5909 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5914 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5915 c & ' jj=',jj,' kk=',kk
5917 C Contacts I-J and (I+1)-J occur simultaneously.
5918 C The system loses extra energy.
5919 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5926 c------------------------------------------------------------------------------
5927 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5928 implicit real*8 (a-h,o-z)
5929 include 'DIMENSIONS'
5930 include 'COMMON.IOUNITS'
5931 include 'COMMON.DERIV'
5932 include 'COMMON.INTERACT'
5933 include 'COMMON.CONTACTS'
5934 double precision gx(3),gx1(3)
5944 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5945 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5946 C Following 4 lines for diagnostics.
5951 cd write (iout,*)'Contacts have occurred for peptide groups',i,j,
5953 cd write (iout,*)'Contacts have occurred for peptide groups',
5954 cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5955 cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5956 C Calculate the multi-body contribution to energy.
5957 ecorr=ecorr+ekont*ees
5959 C Calculate multi-body contributions to the gradient.
5961 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5962 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5963 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5964 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5965 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5966 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5967 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5968 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5969 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5970 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5971 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5972 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5973 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5974 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5978 gradcorr(ll,m)=gradcorr(ll,m)+
5979 & ees*ekl*gacont_hbr(ll,jj,i)-
5980 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5981 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5986 gradcorr(ll,m)=gradcorr(ll,m)+
5987 & ees*eij*gacont_hbr(ll,kk,k)-
5988 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5989 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5996 C---------------------------------------------------------------------------
5997 subroutine dipole(i,j,jj)
5998 implicit real*8 (a-h,o-z)
5999 include 'DIMENSIONS'
6000 include 'DIMENSIONS.ZSCOPT'
6001 include 'COMMON.IOUNITS'
6002 include 'COMMON.CHAIN'
6003 include 'COMMON.FFIELD'
6004 include 'COMMON.DERIV'
6005 include 'COMMON.INTERACT'
6006 include 'COMMON.CONTACTS'
6007 include 'COMMON.TORSION'
6008 include 'COMMON.VAR'
6009 include 'COMMON.GEO'
6010 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6012 iti1 = itortyp(itype(i+1))
6013 if (j.lt.nres-1) then
6014 itj1 = itortyp(itype(j+1))
6019 dipi(iii,1)=Ub2(iii,i)
6020 dipderi(iii)=Ub2der(iii,i)
6021 dipi(iii,2)=b1(iii,iti1)
6022 dipj(iii,1)=Ub2(iii,j)
6023 dipderj(iii)=Ub2der(iii,j)
6024 dipj(iii,2)=b1(iii,itj1)
6028 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6031 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6034 if (.not.calc_grad) return
6039 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6043 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6048 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6049 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6051 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6053 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6055 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6059 C---------------------------------------------------------------------------
6060 subroutine calc_eello(i,j,k,l,jj,kk)
6062 C This subroutine computes matrices and vectors needed to calculate
6063 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6065 implicit real*8 (a-h,o-z)
6066 include 'DIMENSIONS'
6067 include 'DIMENSIONS.ZSCOPT'
6068 include 'COMMON.IOUNITS'
6069 include 'COMMON.CHAIN'
6070 include 'COMMON.DERIV'
6071 include 'COMMON.INTERACT'
6072 include 'COMMON.CONTACTS'
6073 include 'COMMON.TORSION'
6074 include 'COMMON.VAR'
6075 include 'COMMON.GEO'
6076 include 'COMMON.FFIELD'
6077 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6078 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6081 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6082 cd & ' jj=',jj,' kk=',kk
6083 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6086 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6087 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6090 call transpose2(aa1(1,1),aa1t(1,1))
6091 call transpose2(aa2(1,1),aa2t(1,1))
6094 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6095 & aa1tder(1,1,lll,kkk))
6096 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6097 & aa2tder(1,1,lll,kkk))
6101 C parallel orientation of the two CA-CA-CA frames.
6103 iti=itortyp(itype(i))
6107 itk1=itortyp(itype(k+1))
6108 itj=itortyp(itype(j))
6109 if (l.lt.nres-1) then
6110 itl1=itortyp(itype(l+1))
6114 C A1 kernel(j+1) A2T
6116 cd write (iout,'(3f10.5,5x,3f10.5)')
6117 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6119 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6120 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6121 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6122 C Following matrices are needed only for 6-th order cumulants
6123 IF (wcorr6.gt.0.0d0) THEN
6124 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6125 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6126 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6127 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6128 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6129 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6130 & ADtEAderx(1,1,1,1,1,1))
6132 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6133 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6134 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6135 & ADtEA1derx(1,1,1,1,1,1))
6137 C End 6-th order cumulants
6140 cd write (2,*) 'In calc_eello6'
6142 cd write (2,*) 'iii=',iii
6144 cd write (2,*) 'kkk=',kkk
6146 cd write (2,'(3(2f10.5),5x)')
6147 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6152 call transpose2(EUgder(1,1,k),auxmat(1,1))
6153 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6154 call transpose2(EUg(1,1,k),auxmat(1,1))
6155 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6156 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6160 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6161 & EAEAderx(1,1,lll,kkk,iii,1))
6165 C A1T kernel(i+1) A2
6166 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6167 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6168 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6169 C Following matrices are needed only for 6-th order cumulants
6170 IF (wcorr6.gt.0.0d0) THEN
6171 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6172 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6173 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6174 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6175 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6176 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6177 & ADtEAderx(1,1,1,1,1,2))
6178 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6179 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6180 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6181 & ADtEA1derx(1,1,1,1,1,2))
6183 C End 6-th order cumulants
6184 call transpose2(EUgder(1,1,l),auxmat(1,1))
6185 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6186 call transpose2(EUg(1,1,l),auxmat(1,1))
6187 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6188 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6192 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6193 & EAEAderx(1,1,lll,kkk,iii,2))
6198 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6199 C They are needed only when the fifth- or the sixth-order cumulants are
6201 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6202 call transpose2(AEA(1,1,1),auxmat(1,1))
6203 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6204 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6205 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6206 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6207 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6208 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6209 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6210 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6211 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6212 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6213 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6214 call transpose2(AEA(1,1,2),auxmat(1,1))
6215 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6216 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6217 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6218 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6219 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6220 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6221 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6222 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6223 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6224 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6225 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6226 C Calculate the Cartesian derivatives of the vectors.
6230 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6231 call matvec2(auxmat(1,1),b1(1,iti),
6232 & AEAb1derx(1,lll,kkk,iii,1,1))
6233 call matvec2(auxmat(1,1),Ub2(1,i),
6234 & AEAb2derx(1,lll,kkk,iii,1,1))
6235 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6236 & AEAb1derx(1,lll,kkk,iii,2,1))
6237 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6238 & AEAb2derx(1,lll,kkk,iii,2,1))
6239 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6240 call matvec2(auxmat(1,1),b1(1,itj),
6241 & AEAb1derx(1,lll,kkk,iii,1,2))
6242 call matvec2(auxmat(1,1),Ub2(1,j),
6243 & AEAb2derx(1,lll,kkk,iii,1,2))
6244 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6245 & AEAb1derx(1,lll,kkk,iii,2,2))
6246 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6247 & AEAb2derx(1,lll,kkk,iii,2,2))
6254 C Antiparallel orientation of the two CA-CA-CA frames.
6256 iti=itortyp(itype(i))
6260 itk1=itortyp(itype(k+1))
6261 itl=itortyp(itype(l))
6262 itj=itortyp(itype(j))
6263 if (j.lt.nres-1) then
6264 itj1=itortyp(itype(j+1))
6268 C A2 kernel(j-1)T A1T
6269 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6270 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6271 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6272 C Following matrices are needed only for 6-th order cumulants
6273 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6274 & j.eq.i+4 .and. l.eq.i+3)) THEN
6275 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6276 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6277 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6278 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6279 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6280 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6281 & ADtEAderx(1,1,1,1,1,1))
6282 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6283 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6284 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6285 & ADtEA1derx(1,1,1,1,1,1))
6287 C End 6-th order cumulants
6288 call transpose2(EUgder(1,1,k),auxmat(1,1))
6289 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6290 call transpose2(EUg(1,1,k),auxmat(1,1))
6291 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6292 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6296 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6297 & EAEAderx(1,1,lll,kkk,iii,1))
6301 C A2T kernel(i+1)T A1
6302 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6303 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6304 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6305 C Following matrices are needed only for 6-th order cumulants
6306 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6307 & j.eq.i+4 .and. l.eq.i+3)) THEN
6308 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6309 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6310 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6311 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6312 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6313 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6314 & ADtEAderx(1,1,1,1,1,2))
6315 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6316 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6317 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6318 & ADtEA1derx(1,1,1,1,1,2))
6320 C End 6-th order cumulants
6321 call transpose2(EUgder(1,1,j),auxmat(1,1))
6322 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6323 call transpose2(EUg(1,1,j),auxmat(1,1))
6324 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6325 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6329 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6330 & EAEAderx(1,1,lll,kkk,iii,2))
6335 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6336 C They are needed only when the fifth- or the sixth-order cumulants are
6338 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6339 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6340 call transpose2(AEA(1,1,1),auxmat(1,1))
6341 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6342 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6343 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6344 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6345 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6346 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6347 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6348 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6349 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6350 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6351 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6352 call transpose2(AEA(1,1,2),auxmat(1,1))
6353 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6354 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6355 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6356 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6357 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6358 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6359 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6360 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6361 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6362 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6363 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6364 C Calculate the Cartesian derivatives of the vectors.
6368 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6369 call matvec2(auxmat(1,1),b1(1,iti),
6370 & AEAb1derx(1,lll,kkk,iii,1,1))
6371 call matvec2(auxmat(1,1),Ub2(1,i),
6372 & AEAb2derx(1,lll,kkk,iii,1,1))
6373 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6374 & AEAb1derx(1,lll,kkk,iii,2,1))
6375 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6376 & AEAb2derx(1,lll,kkk,iii,2,1))
6377 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6378 call matvec2(auxmat(1,1),b1(1,itl),
6379 & AEAb1derx(1,lll,kkk,iii,1,2))
6380 call matvec2(auxmat(1,1),Ub2(1,l),
6381 & AEAb2derx(1,lll,kkk,iii,1,2))
6382 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6383 & AEAb1derx(1,lll,kkk,iii,2,2))
6384 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6385 & AEAb2derx(1,lll,kkk,iii,2,2))
6394 C---------------------------------------------------------------------------
6395 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6396 & KK,KKderg,AKA,AKAderg,AKAderx)
6400 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6401 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6402 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6407 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6409 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6412 cd if (lprn) write (2,*) 'In kernel'
6414 cd if (lprn) write (2,*) 'kkk=',kkk
6416 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6417 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6419 cd write (2,*) 'lll=',lll
6420 cd write (2,*) 'iii=1'
6422 cd write (2,'(3(2f10.5),5x)')
6423 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6426 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6427 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6429 cd write (2,*) 'lll=',lll
6430 cd write (2,*) 'iii=2'
6432 cd write (2,'(3(2f10.5),5x)')
6433 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6440 C---------------------------------------------------------------------------
6441 double precision function eello4(i,j,k,l,jj,kk)
6442 implicit real*8 (a-h,o-z)
6443 include 'DIMENSIONS'
6444 include 'DIMENSIONS.ZSCOPT'
6445 include 'COMMON.IOUNITS'
6446 include 'COMMON.CHAIN'
6447 include 'COMMON.DERIV'
6448 include 'COMMON.INTERACT'
6449 include 'COMMON.CONTACTS'
6450 include 'COMMON.TORSION'
6451 include 'COMMON.VAR'
6452 include 'COMMON.GEO'
6453 double precision pizda(2,2),ggg1(3),ggg2(3)
6454 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6458 cd print *,'eello4:',i,j,k,l,jj,kk
6459 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6460 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6461 cold eij=facont_hb(jj,i)
6462 cold ekl=facont_hb(kk,k)
6464 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6466 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6467 gcorr_loc(k-1)=gcorr_loc(k-1)
6468 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6470 gcorr_loc(l-1)=gcorr_loc(l-1)
6471 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6473 gcorr_loc(j-1)=gcorr_loc(j-1)
6474 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6479 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6480 & -EAEAderx(2,2,lll,kkk,iii,1)
6481 cd derx(lll,kkk,iii)=0.0d0
6485 cd gcorr_loc(l-1)=0.0d0
6486 cd gcorr_loc(j-1)=0.0d0
6487 cd gcorr_loc(k-1)=0.0d0
6489 cd write (iout,*)'Contacts have occurred for peptide groups',
6490 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6491 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6492 if (j.lt.nres-1) then
6499 if (l.lt.nres-1) then
6507 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6508 ggg1(ll)=eel4*g_contij(ll,1)
6509 ggg2(ll)=eel4*g_contij(ll,2)
6510 ghalf=0.5d0*ggg1(ll)
6512 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6513 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6514 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6515 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6516 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6517 ghalf=0.5d0*ggg2(ll)
6519 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6520 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6521 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6522 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6527 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6528 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6533 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6534 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6540 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6545 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6549 cd write (2,*) iii,gcorr_loc(iii)
6553 cd write (2,*) 'ekont',ekont
6554 cd write (iout,*) 'eello4',ekont*eel4
6557 C---------------------------------------------------------------------------
6558 double precision function eello5(i,j,k,l,jj,kk)
6559 implicit real*8 (a-h,o-z)
6560 include 'DIMENSIONS'
6561 include 'DIMENSIONS.ZSCOPT'
6562 include 'COMMON.IOUNITS'
6563 include 'COMMON.CHAIN'
6564 include 'COMMON.DERIV'
6565 include 'COMMON.INTERACT'
6566 include 'COMMON.CONTACTS'
6567 include 'COMMON.TORSION'
6568 include 'COMMON.VAR'
6569 include 'COMMON.GEO'
6570 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6571 double precision ggg1(3),ggg2(3)
6572 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6577 C /l\ / \ \ / \ / \ / C
6578 C / \ / \ \ / \ / \ / C
6579 C j| o |l1 | o | o| o | | o |o C
6580 C \ |/k\| |/ \| / |/ \| |/ \| C
6581 C \i/ \ / \ / / \ / \ C
6583 C (I) (II) (III) (IV) C
6585 C eello5_1 eello5_2 eello5_3 eello5_4 C
6587 C Antiparallel chains C
6590 C /j\ / \ \ / \ / \ / C
6591 C / \ / \ \ / \ / \ / C
6592 C j1| o |l | o | o| o | | o |o C
6593 C \ |/k\| |/ \| / |/ \| |/ \| C
6594 C \i/ \ / \ / / \ / \ C
6596 C (I) (II) (III) (IV) C
6598 C eello5_1 eello5_2 eello5_3 eello5_4 C
6600 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6602 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6603 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6608 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6610 itk=itortyp(itype(k))
6611 itl=itortyp(itype(l))
6612 itj=itortyp(itype(j))
6617 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6618 cd & eel5_3_num,eel5_4_num)
6622 derx(lll,kkk,iii)=0.0d0
6626 cd eij=facont_hb(jj,i)
6627 cd ekl=facont_hb(kk,k)
6629 cd write (iout,*)'Contacts have occurred for peptide groups',
6630 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6632 C Contribution from the graph I.
6633 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6634 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6635 call transpose2(EUg(1,1,k),auxmat(1,1))
6636 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6637 vv(1)=pizda(1,1)-pizda(2,2)
6638 vv(2)=pizda(1,2)+pizda(2,1)
6639 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6640 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6642 C Explicit gradient in virtual-dihedral angles.
6643 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6644 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6645 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6646 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6647 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6648 vv(1)=pizda(1,1)-pizda(2,2)
6649 vv(2)=pizda(1,2)+pizda(2,1)
6650 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6651 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6652 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6653 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6654 vv(1)=pizda(1,1)-pizda(2,2)
6655 vv(2)=pizda(1,2)+pizda(2,1)
6657 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6658 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6659 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6661 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6662 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6663 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6665 C Cartesian gradient
6669 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6671 vv(1)=pizda(1,1)-pizda(2,2)
6672 vv(2)=pizda(1,2)+pizda(2,1)
6673 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6674 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6675 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6682 C Contribution from graph II
6683 call transpose2(EE(1,1,itk),auxmat(1,1))
6684 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6685 vv(1)=pizda(1,1)+pizda(2,2)
6686 vv(2)=pizda(2,1)-pizda(1,2)
6687 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6688 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6690 C Explicit gradient in virtual-dihedral angles.
6691 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6692 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6693 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6694 vv(1)=pizda(1,1)+pizda(2,2)
6695 vv(2)=pizda(2,1)-pizda(1,2)
6697 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6698 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6699 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6701 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6702 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6703 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6705 C Cartesian gradient
6709 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6711 vv(1)=pizda(1,1)+pizda(2,2)
6712 vv(2)=pizda(2,1)-pizda(1,2)
6713 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6714 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6715 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6724 C Parallel orientation
6725 C Contribution from graph III
6726 call transpose2(EUg(1,1,l),auxmat(1,1))
6727 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6728 vv(1)=pizda(1,1)-pizda(2,2)
6729 vv(2)=pizda(1,2)+pizda(2,1)
6730 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6731 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6733 C Explicit gradient in virtual-dihedral angles.
6734 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6735 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6736 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6737 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6738 vv(1)=pizda(1,1)-pizda(2,2)
6739 vv(2)=pizda(1,2)+pizda(2,1)
6740 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6741 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6742 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6743 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6744 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6745 vv(1)=pizda(1,1)-pizda(2,2)
6746 vv(2)=pizda(1,2)+pizda(2,1)
6747 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6748 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6749 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6750 C Cartesian gradient
6754 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6756 vv(1)=pizda(1,1)-pizda(2,2)
6757 vv(2)=pizda(1,2)+pizda(2,1)
6758 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6759 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6760 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6766 C Contribution from graph IV
6768 call transpose2(EE(1,1,itl),auxmat(1,1))
6769 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6770 vv(1)=pizda(1,1)+pizda(2,2)
6771 vv(2)=pizda(2,1)-pizda(1,2)
6772 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6773 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6775 C Explicit gradient in virtual-dihedral angles.
6776 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6777 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6778 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6779 vv(1)=pizda(1,1)+pizda(2,2)
6780 vv(2)=pizda(2,1)-pizda(1,2)
6781 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6782 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6783 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6784 C Cartesian gradient
6788 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6790 vv(1)=pizda(1,1)+pizda(2,2)
6791 vv(2)=pizda(2,1)-pizda(1,2)
6792 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6793 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6794 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6800 C Antiparallel orientation
6801 C Contribution from graph III
6803 call transpose2(EUg(1,1,j),auxmat(1,1))
6804 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6805 vv(1)=pizda(1,1)-pizda(2,2)
6806 vv(2)=pizda(1,2)+pizda(2,1)
6807 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6808 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6810 C Explicit gradient in virtual-dihedral angles.
6811 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6812 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6813 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6814 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6815 vv(1)=pizda(1,1)-pizda(2,2)
6816 vv(2)=pizda(1,2)+pizda(2,1)
6817 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6818 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6819 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6820 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6821 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6822 vv(1)=pizda(1,1)-pizda(2,2)
6823 vv(2)=pizda(1,2)+pizda(2,1)
6824 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6825 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6826 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6827 C Cartesian gradient
6831 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6833 vv(1)=pizda(1,1)-pizda(2,2)
6834 vv(2)=pizda(1,2)+pizda(2,1)
6835 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6836 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6837 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6843 C Contribution from graph IV
6845 call transpose2(EE(1,1,itj),auxmat(1,1))
6846 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6847 vv(1)=pizda(1,1)+pizda(2,2)
6848 vv(2)=pizda(2,1)-pizda(1,2)
6849 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6850 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6852 C Explicit gradient in virtual-dihedral angles.
6853 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6854 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6855 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6856 vv(1)=pizda(1,1)+pizda(2,2)
6857 vv(2)=pizda(2,1)-pizda(1,2)
6858 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6859 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6860 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6861 C Cartesian gradient
6865 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6867 vv(1)=pizda(1,1)+pizda(2,2)
6868 vv(2)=pizda(2,1)-pizda(1,2)
6869 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6870 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6871 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6878 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6879 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6880 cd write (2,*) 'ijkl',i,j,k,l
6881 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6882 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6884 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6885 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6886 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6887 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6889 if (j.lt.nres-1) then
6896 if (l.lt.nres-1) then
6906 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6908 ggg1(ll)=eel5*g_contij(ll,1)
6909 ggg2(ll)=eel5*g_contij(ll,2)
6910 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6911 ghalf=0.5d0*ggg1(ll)
6913 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6914 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6915 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6916 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6917 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6918 ghalf=0.5d0*ggg2(ll)
6920 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6921 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6922 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6923 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6928 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6929 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6934 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6935 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6941 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6946 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6950 cd write (2,*) iii,g_corr5_loc(iii)
6954 cd write (2,*) 'ekont',ekont
6955 cd write (iout,*) 'eello5',ekont*eel5
6958 c--------------------------------------------------------------------------
6959 double precision function eello6(i,j,k,l,jj,kk)
6960 implicit real*8 (a-h,o-z)
6961 include 'DIMENSIONS'
6962 include 'DIMENSIONS.ZSCOPT'
6963 include 'COMMON.IOUNITS'
6964 include 'COMMON.CHAIN'
6965 include 'COMMON.DERIV'
6966 include 'COMMON.INTERACT'
6967 include 'COMMON.CONTACTS'
6968 include 'COMMON.TORSION'
6969 include 'COMMON.VAR'
6970 include 'COMMON.GEO'
6971 include 'COMMON.FFIELD'
6972 double precision ggg1(3),ggg2(3)
6973 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6978 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6986 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6987 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6991 derx(lll,kkk,iii)=0.0d0
6995 cd eij=facont_hb(jj,i)
6996 cd ekl=facont_hb(kk,k)
7002 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7003 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7004 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7005 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7006 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7007 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7009 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7010 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7011 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7012 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7013 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7014 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7018 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7020 C If turn contributions are considered, they will be handled separately.
7021 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7022 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7023 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7024 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7025 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7026 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7027 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7030 if (j.lt.nres-1) then
7037 if (l.lt.nres-1) then
7045 ggg1(ll)=eel6*g_contij(ll,1)
7046 ggg2(ll)=eel6*g_contij(ll,2)
7047 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7048 ghalf=0.5d0*ggg1(ll)
7050 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7051 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7052 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7053 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7054 ghalf=0.5d0*ggg2(ll)
7055 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7057 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7058 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7059 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7060 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7065 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7066 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7071 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7072 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7078 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7083 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7087 cd write (2,*) iii,g_corr6_loc(iii)
7091 cd write (2,*) 'ekont',ekont
7092 cd write (iout,*) 'eello6',ekont*eel6
7095 c--------------------------------------------------------------------------
7096 double precision function eello6_graph1(i,j,k,l,imat,swap)
7097 implicit real*8 (a-h,o-z)
7098 include 'DIMENSIONS'
7099 include 'DIMENSIONS.ZSCOPT'
7100 include 'COMMON.IOUNITS'
7101 include 'COMMON.CHAIN'
7102 include 'COMMON.DERIV'
7103 include 'COMMON.INTERACT'
7104 include 'COMMON.CONTACTS'
7105 include 'COMMON.TORSION'
7106 include 'COMMON.VAR'
7107 include 'COMMON.GEO'
7108 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7112 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7114 C Parallel Antiparallel C
7120 C \ j|/k\| / \ |/k\|l / C
7125 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7126 itk=itortyp(itype(k))
7127 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7128 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7129 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7130 call transpose2(EUgC(1,1,k),auxmat(1,1))
7131 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7132 vv1(1)=pizda1(1,1)-pizda1(2,2)
7133 vv1(2)=pizda1(1,2)+pizda1(2,1)
7134 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7135 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7136 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7137 s5=scalar2(vv(1),Dtobr2(1,i))
7138 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7139 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7140 if (.not. calc_grad) return
7141 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7142 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7143 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7144 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7145 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7146 & +scalar2(vv(1),Dtobr2der(1,i)))
7147 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7148 vv1(1)=pizda1(1,1)-pizda1(2,2)
7149 vv1(2)=pizda1(1,2)+pizda1(2,1)
7150 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7151 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7153 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7154 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7155 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7156 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7157 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7159 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7160 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7161 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7162 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7163 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7165 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7166 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7167 vv1(1)=pizda1(1,1)-pizda1(2,2)
7168 vv1(2)=pizda1(1,2)+pizda1(2,1)
7169 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7170 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7171 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7172 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7181 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7182 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7183 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7184 call transpose2(EUgC(1,1,k),auxmat(1,1))
7185 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7187 vv1(1)=pizda1(1,1)-pizda1(2,2)
7188 vv1(2)=pizda1(1,2)+pizda1(2,1)
7189 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7190 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7191 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7192 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7193 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7194 s5=scalar2(vv(1),Dtobr2(1,i))
7195 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7201 c----------------------------------------------------------------------------
7202 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7203 implicit real*8 (a-h,o-z)
7204 include 'DIMENSIONS'
7205 include 'DIMENSIONS.ZSCOPT'
7206 include 'COMMON.IOUNITS'
7207 include 'COMMON.CHAIN'
7208 include 'COMMON.DERIV'
7209 include 'COMMON.INTERACT'
7210 include 'COMMON.CONTACTS'
7211 include 'COMMON.TORSION'
7212 include 'COMMON.VAR'
7213 include 'COMMON.GEO'
7215 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7216 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7219 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7221 C Parallel Antiparallel C
7227 C \ j|/k\| \ |/k\|l C
7232 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7233 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7234 C AL 7/4/01 s1 would occur in the sixth-order moment,
7235 C but not in a cluster cumulant
7237 s1=dip(1,jj,i)*dip(1,kk,k)
7239 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7240 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7241 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7242 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7243 call transpose2(EUg(1,1,k),auxmat(1,1))
7244 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7245 vv(1)=pizda(1,1)-pizda(2,2)
7246 vv(2)=pizda(1,2)+pizda(2,1)
7247 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7248 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7250 eello6_graph2=-(s1+s2+s3+s4)
7252 eello6_graph2=-(s2+s3+s4)
7255 if (.not. calc_grad) return
7256 C Derivatives in gamma(i-1)
7259 s1=dipderg(1,jj,i)*dip(1,kk,k)
7261 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7262 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7263 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7264 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7266 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7268 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7270 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7272 C Derivatives in gamma(k-1)
7274 s1=dip(1,jj,i)*dipderg(1,kk,k)
7276 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7277 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7278 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7279 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7280 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7281 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7282 vv(1)=pizda(1,1)-pizda(2,2)
7283 vv(2)=pizda(1,2)+pizda(2,1)
7284 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7286 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7288 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7290 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7291 C Derivatives in gamma(j-1) or gamma(l-1)
7294 s1=dipderg(3,jj,i)*dip(1,kk,k)
7296 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7297 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7298 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7299 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7300 vv(1)=pizda(1,1)-pizda(2,2)
7301 vv(2)=pizda(1,2)+pizda(2,1)
7302 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7305 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7307 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7310 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7311 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7313 C Derivatives in gamma(l-1) or gamma(j-1)
7316 s1=dip(1,jj,i)*dipderg(3,kk,k)
7318 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7319 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7320 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7321 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7322 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7323 vv(1)=pizda(1,1)-pizda(2,2)
7324 vv(2)=pizda(1,2)+pizda(2,1)
7325 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7328 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7330 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7333 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7334 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7336 C Cartesian derivatives.
7338 write (2,*) 'In eello6_graph2'
7340 write (2,*) 'iii=',iii
7342 write (2,*) 'kkk=',kkk
7344 write (2,'(3(2f10.5),5x)')
7345 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7355 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7357 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7360 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7362 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7363 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7365 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7366 call transpose2(EUg(1,1,k),auxmat(1,1))
7367 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7369 vv(1)=pizda(1,1)-pizda(2,2)
7370 vv(2)=pizda(1,2)+pizda(2,1)
7371 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7372 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7374 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7376 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7379 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7381 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7388 c----------------------------------------------------------------------------
7389 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7390 implicit real*8 (a-h,o-z)
7391 include 'DIMENSIONS'
7392 include 'DIMENSIONS.ZSCOPT'
7393 include 'COMMON.IOUNITS'
7394 include 'COMMON.CHAIN'
7395 include 'COMMON.DERIV'
7396 include 'COMMON.INTERACT'
7397 include 'COMMON.CONTACTS'
7398 include 'COMMON.TORSION'
7399 include 'COMMON.VAR'
7400 include 'COMMON.GEO'
7401 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7403 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7405 C Parallel Antiparallel C
7411 C j|/k\| / |/k\|l / C
7416 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7418 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7419 C energy moment and not to the cluster cumulant.
7420 iti=itortyp(itype(i))
7421 if (j.lt.nres-1) then
7422 itj1=itortyp(itype(j+1))
7426 itk=itortyp(itype(k))
7427 itk1=itortyp(itype(k+1))
7428 if (l.lt.nres-1) then
7429 itl1=itortyp(itype(l+1))
7434 s1=dip(4,jj,i)*dip(4,kk,k)
7436 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7437 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7438 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7439 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7440 call transpose2(EE(1,1,itk),auxmat(1,1))
7441 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7442 vv(1)=pizda(1,1)+pizda(2,2)
7443 vv(2)=pizda(2,1)-pizda(1,2)
7444 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7445 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7447 eello6_graph3=-(s1+s2+s3+s4)
7449 eello6_graph3=-(s2+s3+s4)
7452 if (.not. calc_grad) return
7453 C Derivatives in gamma(k-1)
7454 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7455 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7456 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7457 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7458 C Derivatives in gamma(l-1)
7459 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7460 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7461 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7462 vv(1)=pizda(1,1)+pizda(2,2)
7463 vv(2)=pizda(2,1)-pizda(1,2)
7464 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7465 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7466 C Cartesian derivatives.
7472 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7474 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7477 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7479 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7480 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7482 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7483 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7485 vv(1)=pizda(1,1)+pizda(2,2)
7486 vv(2)=pizda(2,1)-pizda(1,2)
7487 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7489 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7491 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7494 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7496 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7498 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7504 c----------------------------------------------------------------------------
7505 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7506 implicit real*8 (a-h,o-z)
7507 include 'DIMENSIONS'
7508 include 'DIMENSIONS.ZSCOPT'
7509 include 'COMMON.IOUNITS'
7510 include 'COMMON.CHAIN'
7511 include 'COMMON.DERIV'
7512 include 'COMMON.INTERACT'
7513 include 'COMMON.CONTACTS'
7514 include 'COMMON.TORSION'
7515 include 'COMMON.VAR'
7516 include 'COMMON.GEO'
7517 include 'COMMON.FFIELD'
7518 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7519 & auxvec1(2),auxmat1(2,2)
7521 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7523 C Parallel Antiparallel C
7529 C \ j|/k\| \ |/k\|l C
7534 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7536 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7537 C energy moment and not to the cluster cumulant.
7538 cd write (2,*) 'eello_graph4: wturn6',wturn6
7539 iti=itortyp(itype(i))
7540 itj=itortyp(itype(j))
7541 if (j.lt.nres-1) then
7542 itj1=itortyp(itype(j+1))
7546 itk=itortyp(itype(k))
7547 if (k.lt.nres-1) then
7548 itk1=itortyp(itype(k+1))
7552 itl=itortyp(itype(l))
7553 if (l.lt.nres-1) then
7554 itl1=itortyp(itype(l+1))
7558 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7559 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7560 cd & ' itl',itl,' itl1',itl1
7563 s1=dip(3,jj,i)*dip(3,kk,k)
7565 s1=dip(2,jj,j)*dip(2,kk,l)
7568 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7569 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7571 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7572 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7574 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7575 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7577 call transpose2(EUg(1,1,k),auxmat(1,1))
7578 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7579 vv(1)=pizda(1,1)-pizda(2,2)
7580 vv(2)=pizda(2,1)+pizda(1,2)
7581 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7582 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7584 eello6_graph4=-(s1+s2+s3+s4)
7586 eello6_graph4=-(s2+s3+s4)
7588 if (.not. calc_grad) return
7589 C Derivatives in gamma(i-1)
7593 s1=dipderg(2,jj,i)*dip(3,kk,k)
7595 s1=dipderg(4,jj,j)*dip(2,kk,l)
7598 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7600 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7601 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7603 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7604 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7606 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7607 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7608 cd write (2,*) 'turn6 derivatives'
7610 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7612 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7616 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7618 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7622 C Derivatives in gamma(k-1)
7625 s1=dip(3,jj,i)*dipderg(2,kk,k)
7627 s1=dip(2,jj,j)*dipderg(4,kk,l)
7630 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7631 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7633 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7634 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7636 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7637 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7639 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7640 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7641 vv(1)=pizda(1,1)-pizda(2,2)
7642 vv(2)=pizda(2,1)+pizda(1,2)
7643 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7644 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7646 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7648 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7652 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7654 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7657 C Derivatives in gamma(j-1) or gamma(l-1)
7658 if (l.eq.j+1 .and. l.gt.1) then
7659 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7660 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7661 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7662 vv(1)=pizda(1,1)-pizda(2,2)
7663 vv(2)=pizda(2,1)+pizda(1,2)
7664 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7665 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7666 else if (j.gt.1) then
7667 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7668 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7669 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7670 vv(1)=pizda(1,1)-pizda(2,2)
7671 vv(2)=pizda(2,1)+pizda(1,2)
7672 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7673 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7674 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7676 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7679 C Cartesian derivatives.
7686 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7688 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7692 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7694 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7698 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7700 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7702 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7703 & b1(1,itj1),auxvec(1))
7704 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7706 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7707 & b1(1,itl1),auxvec(1))
7708 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7710 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7712 vv(1)=pizda(1,1)-pizda(2,2)
7713 vv(2)=pizda(2,1)+pizda(1,2)
7714 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7716 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7718 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7721 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7724 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7727 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7729 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7731 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7735 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7737 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7740 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7742 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7750 c----------------------------------------------------------------------------
7751 double precision function eello_turn6(i,jj,kk)
7752 implicit real*8 (a-h,o-z)
7753 include 'DIMENSIONS'
7754 include 'DIMENSIONS.ZSCOPT'
7755 include 'COMMON.IOUNITS'
7756 include 'COMMON.CHAIN'
7757 include 'COMMON.DERIV'
7758 include 'COMMON.INTERACT'
7759 include 'COMMON.CONTACTS'
7760 include 'COMMON.TORSION'
7761 include 'COMMON.VAR'
7762 include 'COMMON.GEO'
7763 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7764 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7766 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7767 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7768 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7769 C the respective energy moment and not to the cluster cumulant.
7774 iti=itortyp(itype(i))
7775 itk=itortyp(itype(k))
7776 itk1=itortyp(itype(k+1))
7777 itl=itortyp(itype(l))
7778 itj=itortyp(itype(j))
7779 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7780 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7781 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7786 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7788 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7792 derx_turn(lll,kkk,iii)=0.0d0
7799 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7801 cd write (2,*) 'eello6_5',eello6_5
7803 call transpose2(AEA(1,1,1),auxmat(1,1))
7804 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7805 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7806 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7810 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7811 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7812 s2 = scalar2(b1(1,itk),vtemp1(1))
7814 call transpose2(AEA(1,1,2),atemp(1,1))
7815 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7816 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7817 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7821 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7822 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7823 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7825 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7826 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7827 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7828 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7829 ss13 = scalar2(b1(1,itk),vtemp4(1))
7830 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7834 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7840 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7842 C Derivatives in gamma(i+2)
7844 call transpose2(AEA(1,1,1),auxmatd(1,1))
7845 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7846 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7847 call transpose2(AEAderg(1,1,2),atempd(1,1))
7848 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7849 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7853 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7854 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7855 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7861 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7862 C Derivatives in gamma(i+3)
7864 call transpose2(AEA(1,1,1),auxmatd(1,1))
7865 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7866 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7867 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7871 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7872 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7873 s2d = scalar2(b1(1,itk),vtemp1d(1))
7875 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7876 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7878 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7880 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7881 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7882 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7892 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7893 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7895 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7896 & -0.5d0*ekont*(s2d+s12d)
7898 C Derivatives in gamma(i+4)
7899 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7900 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7901 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7903 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7904 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7905 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7915 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7917 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7919 C Derivatives in gamma(i+5)
7921 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7922 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7923 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7927 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7928 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7929 s2d = scalar2(b1(1,itk),vtemp1d(1))
7931 call transpose2(AEA(1,1,2),atempd(1,1))
7932 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7933 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7937 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7938 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7940 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7941 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7942 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7952 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7953 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7955 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7956 & -0.5d0*ekont*(s2d+s12d)
7958 C Cartesian derivatives
7963 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7964 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7965 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7969 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7970 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7972 s2d = scalar2(b1(1,itk),vtemp1d(1))
7974 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7975 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7976 s8d = -(atempd(1,1)+atempd(2,2))*
7977 & scalar2(cc(1,1,itl),vtemp2(1))
7981 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7983 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7984 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7991 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7994 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7998 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7999 & - 0.5d0*(s8d+s12d)
8001 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8010 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8012 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8013 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8014 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8015 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8016 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8018 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8019 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8020 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8024 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8025 cd & 16*eel_turn6_num
8027 if (j.lt.nres-1) then
8034 if (l.lt.nres-1) then
8042 ggg1(ll)=eel_turn6*g_contij(ll,1)
8043 ggg2(ll)=eel_turn6*g_contij(ll,2)
8044 ghalf=0.5d0*ggg1(ll)
8046 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8047 & +ekont*derx_turn(ll,2,1)
8048 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8049 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8050 & +ekont*derx_turn(ll,4,1)
8051 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8052 ghalf=0.5d0*ggg2(ll)
8054 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8055 & +ekont*derx_turn(ll,2,2)
8056 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8057 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8058 & +ekont*derx_turn(ll,4,2)
8059 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8064 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8069 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8075 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8080 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8084 cd write (2,*) iii,g_corr6_loc(iii)
8087 eello_turn6=ekont*eel_turn6
8088 cd write (2,*) 'ekont',ekont
8089 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8092 crc-------------------------------------------------
8093 SUBROUTINE MATVEC2(A1,V1,V2)
8094 implicit real*8 (a-h,o-z)
8095 include 'DIMENSIONS'
8096 DIMENSION A1(2,2),V1(2),V2(2)
8100 c 3 VI=VI+A1(I,K)*V1(K)
8104 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8105 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8110 C---------------------------------------
8111 SUBROUTINE MATMAT2(A1,A2,A3)
8112 implicit real*8 (a-h,o-z)
8113 include 'DIMENSIONS'
8114 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8115 c DIMENSION AI3(2,2)
8119 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8125 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8126 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8127 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8128 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8136 c-------------------------------------------------------------------------
8137 double precision function scalar2(u,v)
8139 double precision u(2),v(2)
8142 scalar2=u(1)*v(1)+u(2)*v(2)
8146 C-----------------------------------------------------------------------------
8148 subroutine transpose2(a,at)
8150 double precision a(2,2),at(2,2)
8157 c--------------------------------------------------------------------------
8158 subroutine transpose(n,a,at)
8161 double precision a(n,n),at(n,n)
8169 C---------------------------------------------------------------------------
8170 subroutine prodmat3(a1,a2,kk,transp,prod)
8173 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8175 crc double precision auxmat(2,2),prod_(2,2)
8178 crc call transpose2(kk(1,1),auxmat(1,1))
8179 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8180 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8182 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8183 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8184 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8185 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8186 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8187 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8188 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8189 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8192 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8193 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8195 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8196 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8197 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8198 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8199 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8200 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8201 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8202 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8205 c call transpose2(a2(1,1),a2t(1,1))
8208 crc print *,((prod_(i,j),i=1,2),j=1,2)
8209 crc print *,((prod(i,j),i=1,2),j=1,2)
8213 C-----------------------------------------------------------------------------
8214 double precision function scalar(u,v)
8216 double precision u(3),v(3)