1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
27 if (modecalc.eq.12.or.modecalc.eq.14) then
29 c if (fg_rank.eq.0) call int_from_cart1(.false.)
31 call int_from_cart1(.false.)
35 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
36 c & " nfgtasks",nfgtasks
37 if (nfgtasks.gt.1) then
39 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
40 if (fg_rank.eq.0) then
41 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
42 c print *,"Processor",myrank," BROADCAST iorder"
43 C FG master sets up the WEIGHTS_ array which will be broadcast to the
44 C FG slaves as WEIGHTS array.
64 C FG Master broadcasts the WEIGHTS_ array
65 call MPI_Bcast(weights_(1),n_ene,
66 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
68 C FG slaves receive the WEIGHTS array
69 call MPI_Bcast(weights(1),n_ene,
70 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
72 c print *,"Processor",myrank," BROADCAST weights"
73 c call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION,
74 c & king,FG_COMM,IERR)
75 c call MPI_Bcast(c(1,1),6*nres,MPI_DOUBLE_PRECISION,
76 c & king,FG_COMM,IERR)
77 c print *,"Processor",myrank," BROADCAST c"
78 c call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION,
79 c & king,FG_COMM,IERR)
80 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,
82 c print *,"Processor",myrank," BROADCAST dc"
83 c call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION,
84 c & king,FG_COMM,IERR)
85 c call MPI_Bcast(dc_norm(1,1),6*nres,MPI_DOUBLE_PRECISION,
86 c & king,FG_COMM,IERR)
87 c print *,"Processor",myrank," BROADCAST dc_norm"
88 c call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,
89 c & king,FG_COMM,IERR)
90 c print *,"Processor",myrank," BROADCAST theta"
91 c call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,
92 c & king,FG_COMM,IERR)
93 c print *,"Processor",myrank," BROADCAST phi"
94 c call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,
95 c & king,FG_COMM,IERR)
96 c print *,"Processor",myrank," BROADCAST alph"
97 c call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,
98 c & king,FG_COMM,IERR)
99 c print *,"Processor",myrank," BROADCAST omeg"
100 c call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,
101 c & king,FG_COMM,IERR)
102 c print *,"Processor",myrank," BROADCAST vbld"
103 c call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,
104 c & king,FG_COMM,IERR)
105 time_Bcast=time_Bcast+MPI_Wtime()-time00
107 call int_from_cart1(.false.)
108 c print *,"Processor",myrank," BROADCAST vbld_inv"
110 c print *,'Processor',myrank,' calling etotal ipot=',ipot
111 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
114 C Compute the side-chain and electrostatic interaction energy
116 goto (101,102,103,104,105,106) ipot
117 C Lennard-Jones potential.
119 cd print '(a)','Exit ELJ'
121 C Lennard-Jones-Kihara potential (shifted).
124 C Berne-Pechukas potential (dilated LJ, angular dependence).
127 C Gay-Berne potential (shifted LJ, angular dependence).
130 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
133 C Soft-sphere potential
134 106 call e_softsphere(evdw)
136 C Calculate electrostatic (H-bonding) energy of the main chain.
139 c print *,"Processor",myrank," computed USCSC"
141 c print *,"Processor",myrank," left VEC_AND_DERIV"
144 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
145 & wturn3.gt.0d0.or.wturn4.gt.0d0) then
147 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
148 & wturn3.gt.0d0.or.wturn4.gt.0d0) then
150 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
159 c write (iout,*) "Soft-spheer ELEC potential"
160 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
163 c print *,"Processor",myrank," computed UELEC"
165 C Calculate excluded-volume interaction energy between peptide groups
170 call escp(evdw2,evdw2_14)
176 c write (iout,*) "Soft-sphere SCP potential"
177 call escp_soft_sphere(evdw2,evdw2_14)
180 c Calculate the bond-stretching energy
184 C Calculate the disulfide-bridge and other energy and the contributions
185 C from other distance constraints.
186 cd print *,'Calling EHPB'
188 cd print *,'EHPB exitted succesfully.'
190 C Calculate the virtual-bond-angle energy.
192 if (wang.gt.0d0) then
197 c print *,"Processor",myrank," computed UB"
199 C Calculate the SC local energy.
202 c print *,"Processor",myrank," computed USC"
204 C Calculate the virtual-bond torsional energy.
206 cd print *,'nterm=',nterm
208 call etor(etors,edihcnstr)
213 c print *,"Processor",myrank," computed Utor"
215 C 6/23/01 Calculate double-torsional energy
217 if (wtor_d.gt.0) then
222 c print *,"Processor",myrank," computed Utord"
224 C 21/5/07 Calculate local sicdechain correlation energy
226 if (wsccor.gt.0.0d0) then
227 call eback_sc_corr(esccor)
231 c print *,"Processor",myrank," computed Usccorr"
233 C 12/1/95 Multi-body terms
237 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
238 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
239 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
240 c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
241 c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
248 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
249 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
256 c print *,"Processor",myrank," computed Ucorr"
258 C If performing constraint dynamics, call the constraint energy
259 C after the equilibration time
260 if(usampl.and.totT.gt.eq_time) then
267 c print *,"Processor",myrank," computed Uconstr"
273 energia(2)=evdw2-evdw2_14
290 energia(8)=eello_turn3
291 energia(9)=eello_turn4
298 energia(19)=edihcnstr
300 energia(20)=Uconst+Uconst_back
302 c print *," Processor",myrank," calls SUM_ENERGY"
303 call sum_energy(energia,.true.)
304 c print *," Processor",myrank," left SUM_ENERGY"
307 c-------------------------------------------------------------------------------
308 subroutine sum_energy(energia,reduce)
309 implicit real*8 (a-h,o-z)
314 cMS$ATTRIBUTES C :: proc_proc
320 include 'COMMON.SETUP'
321 include 'COMMON.IOUNITS'
322 double precision energia(0:n_ene),enebuff(0:n_ene+1)
323 include 'COMMON.FFIELD'
324 include 'COMMON.DERIV'
325 include 'COMMON.INTERACT'
326 include 'COMMON.SBRIDGE'
327 include 'COMMON.CHAIN'
329 include 'COMMON.CONTROL'
330 include 'COMMON.TIME1'
333 if (nfgtasks.gt.1 .and. reduce) then
335 write (iout,*) "energies before REDUCE"
336 call enerprint(energia)
340 enebuff(i)=energia(i)
343 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
344 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
346 write (iout,*) "energies after REDUCE"
347 call enerprint(energia)
350 time_Reduce=time_Reduce+MPI_Wtime()-time00
352 if (fg_rank.eq.0) then
356 evdw2=energia(2)+energia(18)
372 eello_turn3=energia(8)
373 eello_turn4=energia(9)
380 edihcnstr=energia(19)
385 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
386 & +wang*ebe+wtor*etors+wscloc*escloc
387 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
388 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
389 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
390 & +wbond*estr+Uconst+wsccor*esccor
392 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
393 & +wang*ebe+wtor*etors+wscloc*escloc
394 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
395 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
396 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
397 & +wbond*estr+Uconst+wsccor*esccor
403 if (isnan(etot).ne.0) energia(0)=1.0d+99
405 if (isnan(etot)) energia(0)=1.0d+99
410 idumm=proc_proc(etot,i)
412 call proc_proc(etot,i)
414 if(i.eq.1)energia(0)=1.0d+99
421 c-------------------------------------------------------------------------------
422 subroutine sum_gradient
423 implicit real*8 (a-h,o-z)
428 cMS$ATTRIBUTES C :: proc_proc
433 double precision gradbufc(3,maxres),gradbufx(3,maxres),
436 include 'COMMON.SETUP'
437 include 'COMMON.IOUNITS'
438 include 'COMMON.FFIELD'
439 include 'COMMON.DERIV'
440 include 'COMMON.INTERACT'
441 include 'COMMON.SBRIDGE'
442 include 'COMMON.CHAIN'
444 include 'COMMON.CONTROL'
445 include 'COMMON.TIME1'
446 include 'COMMON.MAXGRAD'
448 C Sum up the components of the Cartesian gradient.
453 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
454 & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
456 & wstrain*ghpbc(j,i)+
457 & wcorr*gradcorr(j,i)+
458 & wel_loc*gel_loc(j,i)+
459 & wturn3*gcorr3_turn(j,i)+
460 & wturn4*gcorr4_turn(j,i)+
461 & wcorr5*gradcorr5(j,i)+
462 & wcorr6*gradcorr6(j,i)+
463 & wturn6*gcorr6_turn(j,i)+
464 & wsccor*gsccorc(j,i)
465 & +wscloc*gscloc(j,i)
466 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
468 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
469 & wsccor*gsccorx(j,i)
470 & +wscloc*gsclocx(j,i)
476 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
477 & welec*gelc(j,i)+wstrain*ghpbc(j,i)+
479 & wcorr*gradcorr(j,i)+
480 & wel_loc*gel_loc(j,i)+
481 & wturn3*gcorr3_turn(j,i)+
482 & wturn4*gcorr4_turn(j,i)+
483 & wcorr5*gradcorr5(j,i)+
484 & wcorr6*gradcorr6(j,i)+
485 & wturn6*gcorr6_turn(j,i)+
486 & wsccor*gsccorc(j,i)
487 & +wscloc*gscloc(j,i)
488 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
490 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
491 & wsccor*gsccorx(j,i)
492 & +wscloc*gsclocx(j,i)
497 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
498 & +wcorr5*g_corr5_loc(i)
499 & +wcorr6*g_corr6_loc(i)
500 & +wturn4*gel_loc_turn4(i)
501 & +wturn3*gel_loc_turn3(i)
502 & +wturn6*gel_loc_turn6(i)
503 & +wel_loc*gel_loc_loc(i)
504 & +wsccor*gsccor_loc(i)
507 if (nfgtasks.gt.1) then
510 gradbufc(j,i)=gradc(j,i,icg)
511 gradbufx(j,i)=gradx(j,i,icg)
515 glocbuf(i)=gloc(i,icg)
517 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
518 if (fg_rank.eq.0) call MPI_Bcast(1,1,MPI_INTEGER,
519 & king,FG_COMM,IERROR)
521 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
522 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
523 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
524 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
525 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
526 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
527 time_reduce=time_reduce+MPI_Wtime()-time00
530 if (gnorm_check) then
532 c Compute the maximum elements of the gradient
542 gcorr3_turn_max=0.0d0
543 gcorr4_turn_max=0.0d0
546 gcorr6_turn_max=0.0d0
556 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
557 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
558 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
559 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
560 & gvdwc_scp_max=gvdwc_scp_norm
561 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
562 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
563 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
564 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
565 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
566 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
567 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
568 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
569 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
570 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
571 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
572 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
573 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
575 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
576 & gcorr3_turn_max=gcorr3_turn_norm
577 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
579 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
580 & gcorr4_turn_max=gcorr4_turn_norm
581 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
582 if (gradcorr5_norm.gt.gradcorr5_max)
583 & gradcorr5_max=gradcorr5_norm
584 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
585 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
586 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
588 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
589 & gcorr6_turn_max=gcorr6_turn_norm
590 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
591 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
592 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
593 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
594 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
595 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
596 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
597 if (gradx_scp_norm.gt.gradx_scp_max)
598 & gradx_scp_max=gradx_scp_norm
599 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
600 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
601 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
602 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
603 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
604 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
605 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
606 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
610 open(istat,file=statname,position="append")
612 open(istat,file=statname,access="append")
614 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
615 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
616 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
617 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
618 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
619 & gsccorx_max,gsclocx_max
621 if (gvdwc_max.gt.1.0d4) then
622 write (iout,*) "gvdwc gvdwx gradb gradbx"
624 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
625 & gradb(j,i),gradbx(j,i),j=1,3)
627 call pdbout(0.0d0,'cipiszcze',iout)
633 write (iout,*) "gradc gradx gloc"
635 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
636 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
641 c-------------------------------------------------------------------------------
642 subroutine rescale_weights(t_bath)
643 implicit real*8 (a-h,o-z)
645 include 'COMMON.IOUNITS'
646 include 'COMMON.FFIELD'
647 include 'COMMON.SBRIDGE'
648 double precision kfac /2.4d0/
649 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
651 c facT=2*temp0/(t_bath+temp0)
652 if (rescale_mode.eq.0) then
658 else if (rescale_mode.eq.1) then
659 facT=kfac/(kfac-1.0d0+t_bath/temp0)
660 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
661 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
662 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
663 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
664 else if (rescale_mode.eq.2) then
670 facT=licznik/dlog(dexp(x)+dexp(-x))
671 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
672 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
673 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
674 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
676 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
677 write (*,*) "Wrong RESCALE_MODE",rescale_mode
679 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
683 welec=weights(3)*fact
684 wcorr=weights(4)*fact3
685 wcorr5=weights(5)*fact4
686 wcorr6=weights(6)*fact5
687 wel_loc=weights(7)*fact2
688 wturn3=weights(8)*fact2
689 wturn4=weights(9)*fact3
690 wturn6=weights(10)*fact5
691 wtor=weights(13)*fact
692 wtor_d=weights(14)*fact2
693 wsccor=weights(21)*fact
697 C------------------------------------------------------------------------
698 subroutine enerprint(energia)
699 implicit real*8 (a-h,o-z)
701 include 'COMMON.IOUNITS'
702 include 'COMMON.FFIELD'
703 include 'COMMON.SBRIDGE'
705 double precision energia(0:n_ene)
710 evdw2=energia(2)+energia(18)
722 eello_turn3=energia(8)
723 eello_turn4=energia(9)
724 eello_turn6=energia(10)
730 edihcnstr=energia(19)
735 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
736 & estr,wbond,ebe,wang,
737 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
739 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
740 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
743 10 format (/'Virtual-chain energies:'//
744 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
745 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
746 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
747 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
748 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
749 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
750 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
751 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
752 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
753 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
754 & ' (SS bridges & dist. cnstr.)'/
755 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
756 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
757 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
758 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
759 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
760 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
761 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
762 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
763 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
764 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
765 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
766 & 'ETOT= ',1pE16.6,' (total)')
768 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
769 & estr,wbond,ebe,wang,
770 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
772 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
773 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
774 & ebr*nss,Uconst,etot
775 10 format (/'Virtual-chain energies:'//
776 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
777 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
778 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
779 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
780 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
781 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
782 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
783 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
784 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
785 & ' (SS bridges & dist. cnstr.)'/
786 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
787 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
788 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
789 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
790 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
791 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
792 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
793 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
794 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
795 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
796 & 'UCONST=',1pE16.6,' (Constraint energy)'/
797 & 'ETOT= ',1pE16.6,' (total)')
801 C-----------------------------------------------------------------------
804 C This subroutine calculates the interaction energy of nonbonded side chains
805 C assuming the LJ potential of interaction.
807 implicit real*8 (a-h,o-z)
809 parameter (accur=1.0d-10)
812 include 'COMMON.LOCAL'
813 include 'COMMON.CHAIN'
814 include 'COMMON.DERIV'
815 include 'COMMON.INTERACT'
816 include 'COMMON.TORSION'
817 include 'COMMON.SBRIDGE'
818 include 'COMMON.NAMES'
819 include 'COMMON.IOUNITS'
820 include 'COMMON.CONTACTS'
822 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
833 C Calculate SC interaction energy.
836 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
837 cd & 'iend=',iend(i,iint)
838 do j=istart(i,iint),iend(i,iint)
843 C Change 12/1/95 to calculate four-body interactions
844 rij=xj*xj+yj*yj+zj*zj
846 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
847 eps0ij=eps(itypi,itypj)
849 e1=fac*fac*aa(itypi,itypj)
850 e2=fac*bb(itypi,itypj)
852 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
853 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
854 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
855 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
856 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
857 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
860 C Calculate the components of the gradient in DC and X
862 fac=-rrij*(e1+evdwij)
867 gvdwx(k,i)=gvdwx(k,i)-gg(k)
868 gvdwx(k,j)=gvdwx(k,j)+gg(k)
872 gvdwc(l,k)=gvdwc(l,k)+gg(l)
876 C 12/1/95, revised on 5/20/97
878 C Calculate the contact function. The ith column of the array JCONT will
879 C contain the numbers of atoms that make contacts with the atom I (of numbers
880 C greater than I). The arrays FACONT and GACONT will contain the values of
881 C the contact function and its derivative.
883 C Uncomment next line, if the correlation interactions include EVDW explicitly.
884 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
885 C Uncomment next line, if the correlation interactions are contact function only
886 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
888 sigij=sigma(itypi,itypj)
889 r0ij=rs0(itypi,itypj)
891 C Check whether the SC's are not too far to make a contact.
894 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
895 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
897 if (fcont.gt.0.0D0) then
898 C If the SC-SC distance if close to sigma, apply spline.
899 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
900 cAdam & fcont1,fprimcont1)
901 cAdam fcont1=1.0d0-fcont1
902 cAdam if (fcont1.gt.0.0d0) then
903 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
904 cAdam fcont=fcont*fcont1
906 C Uncomment following 4 lines to have the geometric average of the epsilon0's
907 cga eps0ij=1.0d0/dsqrt(eps0ij)
909 cga gg(k)=gg(k)*eps0ij
911 cga eps0ij=-evdwij*eps0ij
912 C Uncomment for AL's type of SC correlation interactions.
914 num_conti=num_conti+1
916 facont(num_conti,i)=fcont*eps0ij
917 fprimcont=eps0ij*fprimcont/rij
919 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
920 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
921 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
922 C Uncomment following 3 lines for Skolnick's type of SC correlation.
923 gacont(1,num_conti,i)=-fprimcont*xj
924 gacont(2,num_conti,i)=-fprimcont*yj
925 gacont(3,num_conti,i)=-fprimcont*zj
926 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
927 cd write (iout,'(2i3,3f10.5)')
928 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
934 num_cont(i)=num_conti
938 gvdwc(j,i)=expon*gvdwc(j,i)
939 gvdwx(j,i)=expon*gvdwx(j,i)
942 C******************************************************************************
946 C To save time, the factor of EXPON has been extracted from ALL components
947 C of GVDWC and GRADX. Remember to multiply them by this factor before further
950 C******************************************************************************
953 C-----------------------------------------------------------------------------
954 subroutine eljk(evdw)
956 C This subroutine calculates the interaction energy of nonbonded side chains
957 C assuming the LJK potential of interaction.
959 implicit real*8 (a-h,o-z)
963 include 'COMMON.LOCAL'
964 include 'COMMON.CHAIN'
965 include 'COMMON.DERIV'
966 include 'COMMON.INTERACT'
967 include 'COMMON.IOUNITS'
968 include 'COMMON.NAMES'
971 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
980 C Calculate SC interaction energy.
983 do j=istart(i,iint),iend(i,iint)
988 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
990 e_augm=augm(itypi,itypj)*fac_augm
993 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
994 fac=r_shift_inv**expon
995 e1=fac*fac*aa(itypi,itypj)
996 e2=fac*bb(itypi,itypj)
998 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
999 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1000 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1001 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1002 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1003 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1004 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1007 C Calculate the components of the gradient in DC and X
1009 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1014 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1015 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1019 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1027 gvdwc(j,i)=expon*gvdwc(j,i)
1028 gvdwx(j,i)=expon*gvdwx(j,i)
1033 C-----------------------------------------------------------------------------
1034 subroutine ebp(evdw)
1036 C This subroutine calculates the interaction energy of nonbonded side chains
1037 C assuming the Berne-Pechukas potential of interaction.
1039 implicit real*8 (a-h,o-z)
1040 include 'DIMENSIONS'
1041 include 'COMMON.GEO'
1042 include 'COMMON.VAR'
1043 include 'COMMON.LOCAL'
1044 include 'COMMON.CHAIN'
1045 include 'COMMON.DERIV'
1046 include 'COMMON.NAMES'
1047 include 'COMMON.INTERACT'
1048 include 'COMMON.IOUNITS'
1049 include 'COMMON.CALC'
1050 common /srutu/ icall
1051 c double precision rrsave(maxdim)
1054 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1056 c if (icall.eq.0) then
1062 do i=iatsc_s,iatsc_e
1068 dxi=dc_norm(1,nres+i)
1069 dyi=dc_norm(2,nres+i)
1070 dzi=dc_norm(3,nres+i)
1071 c dsci_inv=dsc_inv(itypi)
1072 dsci_inv=vbld_inv(i+nres)
1074 C Calculate SC interaction energy.
1076 do iint=1,nint_gr(i)
1077 do j=istart(i,iint),iend(i,iint)
1080 c dscj_inv=dsc_inv(itypj)
1081 dscj_inv=vbld_inv(j+nres)
1082 chi1=chi(itypi,itypj)
1083 chi2=chi(itypj,itypi)
1090 alf12=0.5D0*(alf1+alf2)
1091 C For diagnostics only!!!
1104 dxj=dc_norm(1,nres+j)
1105 dyj=dc_norm(2,nres+j)
1106 dzj=dc_norm(3,nres+j)
1107 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1108 cd if (icall.eq.0) then
1114 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1116 C Calculate whole angle-dependent part of epsilon and contributions
1117 C to its derivatives
1118 fac=(rrij*sigsq)**expon2
1119 e1=fac*fac*aa(itypi,itypj)
1120 e2=fac*bb(itypi,itypj)
1121 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1122 eps2der=evdwij*eps3rt
1123 eps3der=evdwij*eps2rt
1124 evdwij=evdwij*eps2rt*eps3rt
1127 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1128 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1129 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1130 cd & restyp(itypi),i,restyp(itypj),j,
1131 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1132 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1133 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1136 C Calculate gradient components.
1137 e1=e1*eps1*eps2rt**2*eps3rt**2
1138 fac=-expon*(e1+evdwij)
1141 C Calculate radial part of the gradient
1145 C Calculate the angular part of the gradient and sum add the contributions
1146 C to the appropriate components of the Cartesian gradient.
1154 C-----------------------------------------------------------------------------
1155 subroutine egb(evdw)
1157 C This subroutine calculates the interaction energy of nonbonded side chains
1158 C assuming the Gay-Berne potential of interaction.
1160 implicit real*8 (a-h,o-z)
1161 include 'DIMENSIONS'
1162 include 'COMMON.GEO'
1163 include 'COMMON.VAR'
1164 include 'COMMON.LOCAL'
1165 include 'COMMON.CHAIN'
1166 include 'COMMON.DERIV'
1167 include 'COMMON.NAMES'
1168 include 'COMMON.INTERACT'
1169 include 'COMMON.IOUNITS'
1170 include 'COMMON.CALC'
1171 include 'COMMON.CONTROL'
1174 ccccc energy_dec=.false.
1175 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1178 c if (icall.eq.0) lprn=.false.
1180 do i=iatsc_s,iatsc_e
1186 dxi=dc_norm(1,nres+i)
1187 dyi=dc_norm(2,nres+i)
1188 dzi=dc_norm(3,nres+i)
1189 c dsci_inv=dsc_inv(itypi)
1190 dsci_inv=vbld_inv(i+nres)
1191 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1192 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1194 C Calculate SC interaction energy.
1196 do iint=1,nint_gr(i)
1197 do j=istart(i,iint),iend(i,iint)
1200 c dscj_inv=dsc_inv(itypj)
1201 dscj_inv=vbld_inv(j+nres)
1202 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1203 c & 1.0d0/vbld(j+nres)
1204 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1205 sig0ij=sigma(itypi,itypj)
1206 chi1=chi(itypi,itypj)
1207 chi2=chi(itypj,itypi)
1214 alf12=0.5D0*(alf1+alf2)
1215 C For diagnostics only!!!
1228 dxj=dc_norm(1,nres+j)
1229 dyj=dc_norm(2,nres+j)
1230 dzj=dc_norm(3,nres+j)
1231 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1232 c write (iout,*) "j",j," dc_norm",
1233 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1234 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1236 C Calculate angle-dependent terms of energy and contributions to their
1240 sig=sig0ij*dsqrt(sigsq)
1241 rij_shift=1.0D0/rij-sig+sig0ij
1242 c for diagnostics; uncomment
1243 c rij_shift=1.2*sig0ij
1244 C I hate to put IF's in the loops, but here don't have another choice!!!!
1245 if (rij_shift.le.0.0D0) then
1247 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1248 cd & restyp(itypi),i,restyp(itypj),j,
1249 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1253 c---------------------------------------------------------------
1254 rij_shift=1.0D0/rij_shift
1255 fac=rij_shift**expon
1256 e1=fac*fac*aa(itypi,itypj)
1257 e2=fac*bb(itypi,itypj)
1258 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1259 eps2der=evdwij*eps3rt
1260 eps3der=evdwij*eps2rt
1261 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1262 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1263 evdwij=evdwij*eps2rt*eps3rt
1266 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1267 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1268 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1269 & restyp(itypi),i,restyp(itypj),j,
1270 & epsi,sigm,chi1,chi2,chip1,chip2,
1271 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1272 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1276 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1279 C Calculate gradient components.
1280 e1=e1*eps1*eps2rt**2*eps3rt**2
1281 fac=-expon*(e1+evdwij)*rij_shift
1285 C Calculate the radial part of the gradient
1289 C Calculate angular part of the gradient.
1294 c write (iout,*) "Number of loop steps in EGB:",ind
1295 cccc energy_dec=.false.
1298 C-----------------------------------------------------------------------------
1299 subroutine egbv(evdw)
1301 C This subroutine calculates the interaction energy of nonbonded side chains
1302 C assuming the Gay-Berne-Vorobjev potential of interaction.
1304 implicit real*8 (a-h,o-z)
1305 include 'DIMENSIONS'
1306 include 'COMMON.GEO'
1307 include 'COMMON.VAR'
1308 include 'COMMON.LOCAL'
1309 include 'COMMON.CHAIN'
1310 include 'COMMON.DERIV'
1311 include 'COMMON.NAMES'
1312 include 'COMMON.INTERACT'
1313 include 'COMMON.IOUNITS'
1314 include 'COMMON.CALC'
1315 common /srutu/ icall
1318 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1321 c if (icall.eq.0) lprn=.true.
1323 do i=iatsc_s,iatsc_e
1329 dxi=dc_norm(1,nres+i)
1330 dyi=dc_norm(2,nres+i)
1331 dzi=dc_norm(3,nres+i)
1332 c dsci_inv=dsc_inv(itypi)
1333 dsci_inv=vbld_inv(i+nres)
1335 C Calculate SC interaction energy.
1337 do iint=1,nint_gr(i)
1338 do j=istart(i,iint),iend(i,iint)
1341 c dscj_inv=dsc_inv(itypj)
1342 dscj_inv=vbld_inv(j+nres)
1343 sig0ij=sigma(itypi,itypj)
1344 r0ij=r0(itypi,itypj)
1345 chi1=chi(itypi,itypj)
1346 chi2=chi(itypj,itypi)
1353 alf12=0.5D0*(alf1+alf2)
1354 C For diagnostics only!!!
1367 dxj=dc_norm(1,nres+j)
1368 dyj=dc_norm(2,nres+j)
1369 dzj=dc_norm(3,nres+j)
1370 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1372 C Calculate angle-dependent terms of energy and contributions to their
1376 sig=sig0ij*dsqrt(sigsq)
1377 rij_shift=1.0D0/rij-sig+r0ij
1378 C I hate to put IF's in the loops, but here don't have another choice!!!!
1379 if (rij_shift.le.0.0D0) then
1384 c---------------------------------------------------------------
1385 rij_shift=1.0D0/rij_shift
1386 fac=rij_shift**expon
1387 e1=fac*fac*aa(itypi,itypj)
1388 e2=fac*bb(itypi,itypj)
1389 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1390 eps2der=evdwij*eps3rt
1391 eps3der=evdwij*eps2rt
1392 fac_augm=rrij**expon
1393 e_augm=augm(itypi,itypj)*fac_augm
1394 evdwij=evdwij*eps2rt*eps3rt
1395 evdw=evdw+evdwij+e_augm
1397 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1398 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1399 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1400 & restyp(itypi),i,restyp(itypj),j,
1401 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1402 & chi1,chi2,chip1,chip2,
1403 & eps1,eps2rt**2,eps3rt**2,
1404 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1407 C Calculate gradient components.
1408 e1=e1*eps1*eps2rt**2*eps3rt**2
1409 fac=-expon*(e1+evdwij)*rij_shift
1411 fac=rij*fac-2*expon*rrij*e_augm
1412 C Calculate the radial part of the gradient
1416 C Calculate angular part of the gradient.
1422 C-----------------------------------------------------------------------------
1423 subroutine sc_angular
1424 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1425 C om12. Called by ebp, egb, and egbv.
1427 include 'COMMON.CALC'
1428 include 'COMMON.IOUNITS'
1432 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1433 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1434 om12=dxi*dxj+dyi*dyj+dzi*dzj
1436 C Calculate eps1(om12) and its derivative in om12
1437 faceps1=1.0D0-om12*chiom12
1438 faceps1_inv=1.0D0/faceps1
1439 eps1=dsqrt(faceps1_inv)
1440 C Following variable is eps1*deps1/dom12
1441 eps1_om12=faceps1_inv*chiom12
1446 c write (iout,*) "om12",om12," eps1",eps1
1447 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1452 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1453 sigsq=1.0D0-facsig*faceps1_inv
1454 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1455 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1456 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1462 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1463 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1465 C Calculate eps2 and its derivatives in om1, om2, and om12.
1468 chipom12=chip12*om12
1469 facp=1.0D0-om12*chipom12
1471 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1472 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1473 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1474 C Following variable is the square root of eps2
1475 eps2rt=1.0D0-facp1*facp_inv
1476 C Following three variables are the derivatives of the square root of eps
1477 C in om1, om2, and om12.
1478 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1479 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1480 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1481 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1482 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1483 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1484 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1485 c & " eps2rt_om12",eps2rt_om12
1486 C Calculate whole angle-dependent part of epsilon and contributions
1487 C to its derivatives
1490 C----------------------------------------------------------------------------
1492 implicit real*8 (a-h,o-z)
1493 include 'DIMENSIONS'
1494 include 'COMMON.CHAIN'
1495 include 'COMMON.DERIV'
1496 include 'COMMON.CALC'
1497 include 'COMMON.IOUNITS'
1498 double precision dcosom1(3),dcosom2(3)
1499 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1500 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1501 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1502 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1506 c eom12=evdwij*eps1_om12
1508 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1509 c & " sigder",sigder
1510 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1511 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1513 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1514 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1517 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1519 c write (iout,*) "gg",(gg(k),k=1,3)
1521 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1522 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1523 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1524 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1525 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1526 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1527 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1528 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1529 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1530 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1533 C Calculate the components of the gradient in DC and X
1537 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1542 C-----------------------------------------------------------------------
1543 subroutine e_softsphere(evdw)
1545 C This subroutine calculates the interaction energy of nonbonded side chains
1546 C assuming the LJ potential of interaction.
1548 implicit real*8 (a-h,o-z)
1549 include 'DIMENSIONS'
1550 parameter (accur=1.0d-10)
1551 include 'COMMON.GEO'
1552 include 'COMMON.VAR'
1553 include 'COMMON.LOCAL'
1554 include 'COMMON.CHAIN'
1555 include 'COMMON.DERIV'
1556 include 'COMMON.INTERACT'
1557 include 'COMMON.TORSION'
1558 include 'COMMON.SBRIDGE'
1559 include 'COMMON.NAMES'
1560 include 'COMMON.IOUNITS'
1561 include 'COMMON.CONTACTS'
1563 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1565 do i=iatsc_s,iatsc_e
1572 C Calculate SC interaction energy.
1574 do iint=1,nint_gr(i)
1575 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1576 cd & 'iend=',iend(i,iint)
1577 do j=istart(i,iint),iend(i,iint)
1582 rij=xj*xj+yj*yj+zj*zj
1583 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1584 r0ij=r0(itypi,itypj)
1586 c print *,i,j,r0ij,dsqrt(rij)
1587 if (rij.lt.r0ijsq) then
1588 evdwij=0.25d0*(rij-r0ijsq)**2
1596 C Calculate the components of the gradient in DC and X
1602 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1603 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1607 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1615 C--------------------------------------------------------------------------
1616 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1619 C Soft-sphere potential of p-p interaction
1621 implicit real*8 (a-h,o-z)
1622 include 'DIMENSIONS'
1623 include 'COMMON.CONTROL'
1624 include 'COMMON.IOUNITS'
1625 include 'COMMON.GEO'
1626 include 'COMMON.VAR'
1627 include 'COMMON.LOCAL'
1628 include 'COMMON.CHAIN'
1629 include 'COMMON.DERIV'
1630 include 'COMMON.INTERACT'
1631 include 'COMMON.CONTACTS'
1632 include 'COMMON.TORSION'
1633 include 'COMMON.VECTORS'
1634 include 'COMMON.FFIELD'
1636 cd write(iout,*) 'In EELEC_soft_sphere'
1644 do i=iatel_s,iatel_e
1648 xmedi=c(1,i)+0.5d0*dxi
1649 ymedi=c(2,i)+0.5d0*dyi
1650 zmedi=c(3,i)+0.5d0*dzi
1652 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1653 do j=ielstart(i),ielend(i)
1657 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1658 r0ij=rpp(iteli,itelj)
1663 xj=c(1,j)+0.5D0*dxj-xmedi
1664 yj=c(2,j)+0.5D0*dyj-ymedi
1665 zj=c(3,j)+0.5D0*dzj-zmedi
1666 rij=xj*xj+yj*yj+zj*zj
1667 if (rij.lt.r0ijsq) then
1668 evdw1ij=0.25d0*(rij-r0ijsq)**2
1676 C Calculate contributions to the Cartesian gradient.
1683 gelc(k,i)=gelc(k,i)+ghalf
1684 gelc(k,j)=gelc(k,j)+ghalf
1687 * Loop over residues i+1 thru j-1.
1691 gelc(l,k)=gelc(l,k)+ggg(l)
1698 c------------------------------------------------------------------------------
1699 subroutine vec_and_deriv
1700 implicit real*8 (a-h,o-z)
1701 include 'DIMENSIONS'
1705 include 'COMMON.IOUNITS'
1706 include 'COMMON.GEO'
1707 include 'COMMON.VAR'
1708 include 'COMMON.LOCAL'
1709 include 'COMMON.CHAIN'
1710 include 'COMMON.VECTORS'
1711 include 'COMMON.SETUP'
1712 include 'COMMON.TIME1'
1713 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1714 C Compute the local reference systems. For reference system (i), the
1715 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1716 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1718 do i=ivec_start,ivec_end
1719 if (i.eq.nres-1) then
1720 C Case of the last full residue
1721 C Compute the Z-axis
1722 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1723 costh=dcos(pi-theta(nres))
1724 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1728 C Compute the derivatives of uz
1730 uzder(2,1,1)=-dc_norm(3,i-1)
1731 uzder(3,1,1)= dc_norm(2,i-1)
1732 uzder(1,2,1)= dc_norm(3,i-1)
1734 uzder(3,2,1)=-dc_norm(1,i-1)
1735 uzder(1,3,1)=-dc_norm(2,i-1)
1736 uzder(2,3,1)= dc_norm(1,i-1)
1739 uzder(2,1,2)= dc_norm(3,i)
1740 uzder(3,1,2)=-dc_norm(2,i)
1741 uzder(1,2,2)=-dc_norm(3,i)
1743 uzder(3,2,2)= dc_norm(1,i)
1744 uzder(1,3,2)= dc_norm(2,i)
1745 uzder(2,3,2)=-dc_norm(1,i)
1747 C Compute the Y-axis
1750 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1752 C Compute the derivatives of uy
1755 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1756 & -dc_norm(k,i)*dc_norm(j,i-1)
1757 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1759 uyder(j,j,1)=uyder(j,j,1)-costh
1760 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1765 uygrad(l,k,j,i)=uyder(l,k,j)
1766 uzgrad(l,k,j,i)=uzder(l,k,j)
1770 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1771 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1772 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1773 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1776 C Compute the Z-axis
1777 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1778 costh=dcos(pi-theta(i+2))
1779 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1783 C Compute the derivatives of uz
1785 uzder(2,1,1)=-dc_norm(3,i+1)
1786 uzder(3,1,1)= dc_norm(2,i+1)
1787 uzder(1,2,1)= dc_norm(3,i+1)
1789 uzder(3,2,1)=-dc_norm(1,i+1)
1790 uzder(1,3,1)=-dc_norm(2,i+1)
1791 uzder(2,3,1)= dc_norm(1,i+1)
1794 uzder(2,1,2)= dc_norm(3,i)
1795 uzder(3,1,2)=-dc_norm(2,i)
1796 uzder(1,2,2)=-dc_norm(3,i)
1798 uzder(3,2,2)= dc_norm(1,i)
1799 uzder(1,3,2)= dc_norm(2,i)
1800 uzder(2,3,2)=-dc_norm(1,i)
1802 C Compute the Y-axis
1805 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1807 C Compute the derivatives of uy
1810 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1811 & -dc_norm(k,i)*dc_norm(j,i+1)
1812 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1814 uyder(j,j,1)=uyder(j,j,1)-costh
1815 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1820 uygrad(l,k,j,i)=uyder(l,k,j)
1821 uzgrad(l,k,j,i)=uzder(l,k,j)
1825 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1826 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1827 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1828 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1832 vbld_inv_temp(1)=vbld_inv(i+1)
1833 if (i.lt.nres-1) then
1834 vbld_inv_temp(2)=vbld_inv(i+2)
1836 vbld_inv_temp(2)=vbld_inv(i)
1841 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1842 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1848 if (nfgtasks.gt.1) then
1850 c print *,"Processor",fg_rank,kolor," ivec_start",ivec_start,
1851 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
1852 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
1853 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank),
1854 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
1856 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank),
1857 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
1859 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
1860 & ivec_count(fg_rank),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
1861 & ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR)
1862 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
1863 & ivec_count(fg_rank),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
1864 & ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR)
1865 time_gather=time_gather+MPI_Wtime()-time00
1867 c if (fg_rank.eq.0) then
1868 c write (iout,*) "Arrays UY and UZ"
1870 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
1877 C-----------------------------------------------------------------------------
1878 subroutine check_vecgrad
1879 implicit real*8 (a-h,o-z)
1880 include 'DIMENSIONS'
1881 include 'COMMON.IOUNITS'
1882 include 'COMMON.GEO'
1883 include 'COMMON.VAR'
1884 include 'COMMON.LOCAL'
1885 include 'COMMON.CHAIN'
1886 include 'COMMON.VECTORS'
1887 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1888 dimension uyt(3,maxres),uzt(3,maxres)
1889 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1890 double precision delta /1.0d-7/
1893 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1894 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1895 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1896 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1897 cd & (dc_norm(if90,i),if90=1,3)
1898 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1899 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1900 cd write(iout,'(a)')
1906 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1907 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1920 cd write (iout,*) 'i=',i
1922 erij(k)=dc_norm(k,i)
1926 dc_norm(k,i)=erij(k)
1928 dc_norm(j,i)=dc_norm(j,i)+delta
1929 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1931 c dc_norm(k,i)=dc_norm(k,i)/fac
1933 c write (iout,*) (dc_norm(k,i),k=1,3)
1934 c write (iout,*) (erij(k),k=1,3)
1937 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1938 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1939 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1940 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1942 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1943 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1944 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1947 dc_norm(k,i)=erij(k)
1950 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1951 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1952 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1953 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1954 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1955 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1956 cd write (iout,'(a)')
1961 C--------------------------------------------------------------------------
1962 subroutine set_matrices
1963 implicit real*8 (a-h,o-z)
1964 include 'DIMENSIONS'
1965 include 'COMMON.IOUNITS'
1966 include 'COMMON.GEO'
1967 include 'COMMON.VAR'
1968 include 'COMMON.LOCAL'
1969 include 'COMMON.CHAIN'
1970 include 'COMMON.DERIV'
1971 include 'COMMON.INTERACT'
1972 include 'COMMON.CONTACTS'
1973 include 'COMMON.TORSION'
1974 include 'COMMON.VECTORS'
1975 include 'COMMON.FFIELD'
1976 double precision auxvec(2),auxmat(2,2)
1978 C Compute the virtual-bond-torsional-angle dependent quantities needed
1979 C to calculate the el-loc multibody terms of various order.
1982 if (i .lt. nres+1) then
2019 if (i .gt. 3 .and. i .lt. nres+1) then
2020 obrot_der(1,i-2)=-sin1
2021 obrot_der(2,i-2)= cos1
2022 Ugder(1,1,i-2)= sin1
2023 Ugder(1,2,i-2)=-cos1
2024 Ugder(2,1,i-2)=-cos1
2025 Ugder(2,2,i-2)=-sin1
2028 obrot2_der(1,i-2)=-dwasin2
2029 obrot2_der(2,i-2)= dwacos2
2030 Ug2der(1,1,i-2)= dwasin2
2031 Ug2der(1,2,i-2)=-dwacos2
2032 Ug2der(2,1,i-2)=-dwacos2
2033 Ug2der(2,2,i-2)=-dwasin2
2035 obrot_der(1,i-2)=0.0d0
2036 obrot_der(2,i-2)=0.0d0
2037 Ugder(1,1,i-2)=0.0d0
2038 Ugder(1,2,i-2)=0.0d0
2039 Ugder(2,1,i-2)=0.0d0
2040 Ugder(2,2,i-2)=0.0d0
2041 obrot2_der(1,i-2)=0.0d0
2042 obrot2_der(2,i-2)=0.0d0
2043 Ug2der(1,1,i-2)=0.0d0
2044 Ug2der(1,2,i-2)=0.0d0
2045 Ug2der(2,1,i-2)=0.0d0
2046 Ug2der(2,2,i-2)=0.0d0
2048 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2049 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2050 iti = itortyp(itype(i-2))
2054 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2055 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2056 iti1 = itortyp(itype(i-1))
2060 cd write (iout,*) '*******i',i,' iti1',iti
2061 cd write (iout,*) 'b1',b1(:,iti)
2062 cd write (iout,*) 'b2',b2(:,iti)
2063 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2064 c if (i .gt. iatel_s+2) then
2065 if (i .gt. nnt+2) then
2066 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2067 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2068 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2069 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2070 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2071 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2072 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2082 DtUg2(l,k,i-2)=0.0d0
2086 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2087 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2088 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2089 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2090 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2091 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2092 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2094 muder(k,i-2)=Ub2der(k,i-2)
2096 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2097 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2098 iti1 = itortyp(itype(i-1))
2103 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2105 C Vectors and matrices dependent on a single virtual-bond dihedral.
2106 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2107 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2108 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2109 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2110 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2111 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2112 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2113 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2114 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2115 cd write (iout,*) 'mu ',mu(:,i-2)
2116 cd write (iout,*) 'mu1',mu1(:,i-2)
2117 cd write (iout,*) 'mu2',mu2(:,i-2)
2119 C Matrices dependent on two consecutive virtual-bond dihedrals.
2120 C The order of matrices is from left to right.
2122 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2123 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2124 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2125 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2126 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2127 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2128 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2129 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2132 cd iti = itortyp(itype(i))
2135 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2136 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2141 C--------------------------------------------------------------------------
2142 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2144 C This subroutine calculates the average interaction energy and its gradient
2145 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2146 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2147 C The potential depends both on the distance of peptide-group centers and on
2148 C the orientation of the CA-CA virtual bonds.
2150 implicit real*8 (a-h,o-z)
2151 include 'DIMENSIONS'
2152 include 'COMMON.CONTROL'
2153 include 'COMMON.IOUNITS'
2154 include 'COMMON.GEO'
2155 include 'COMMON.VAR'
2156 include 'COMMON.LOCAL'
2157 include 'COMMON.CHAIN'
2158 include 'COMMON.DERIV'
2159 include 'COMMON.INTERACT'
2160 include 'COMMON.CONTACTS'
2161 include 'COMMON.TORSION'
2162 include 'COMMON.VECTORS'
2163 include 'COMMON.FFIELD'
2164 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2165 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2166 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2167 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2168 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2169 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2171 double precision scal_el /1.0d0/
2173 double precision scal_el /0.5d0/
2176 C 13-go grudnia roku pamietnego...
2177 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2178 & 0.0d0,1.0d0,0.0d0,
2179 & 0.0d0,0.0d0,1.0d0/
2180 cd write(iout,*) 'In EELEC'
2182 cd write(iout,*) 'Type',i
2183 cd write(iout,*) 'B1',B1(:,i)
2184 cd write(iout,*) 'B2',B2(:,i)
2185 cd write(iout,*) 'CC',CC(:,:,i)
2186 cd write(iout,*) 'DD',DD(:,:,i)
2187 cd write(iout,*) 'EE',EE(:,:,i)
2189 cd call check_vecgrad
2191 if (icheckgrad.eq.1) then
2193 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2195 dc_norm(k,i)=dc(k,i)*fac
2197 c write (iout,*) 'i',i,' fac',fac
2200 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2201 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2202 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2203 c call vec_and_deriv
2207 cd write (iout,*) 'i=',i
2209 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2212 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2213 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2226 cd print '(a)','Enter EELEC'
2227 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2229 gel_loc_loc(i)=0.0d0
2232 do i=iatel_s,iatel_e
2236 dx_normi=dc_norm(1,i)
2237 dy_normi=dc_norm(2,i)
2238 dz_normi=dc_norm(3,i)
2239 xmedi=c(1,i)+0.5d0*dxi
2240 ymedi=c(2,i)+0.5d0*dyi
2241 zmedi=c(3,i)+0.5d0*dzi
2243 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2244 do j=ielstart(i),ielend(i)
2248 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2249 aaa=app(iteli,itelj)
2250 bbb=bpp(iteli,itelj)
2251 ael6i=ael6(iteli,itelj)
2252 ael3i=ael3(iteli,itelj)
2253 C Diagnostics only!!!
2262 dx_normj=dc_norm(1,j)
2263 dy_normj=dc_norm(2,j)
2264 dz_normj=dc_norm(3,j)
2265 xj=c(1,j)+0.5D0*dxj-xmedi
2266 yj=c(2,j)+0.5D0*dyj-ymedi
2267 zj=c(3,j)+0.5D0*dzj-zmedi
2268 rij=xj*xj+yj*yj+zj*zj
2274 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2275 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2276 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2277 fac=cosa-3.0D0*cosb*cosg
2279 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2280 if (j.eq.i+2) ev1=scal_el*ev1
2285 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2288 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2289 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2292 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2293 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2294 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2295 cd & xmedi,ymedi,zmedi,xj,yj,zj
2297 if (energy_dec) then
2298 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2299 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2303 C Calculate contributions to the Cartesian gradient.
2306 facvdw=-6*rrmij*(ev1+evdwij)
2307 facel=-3*rrmij*(el1+eesij)
2313 * Radial derivatives. First process both termini of the fragment (i,j)
2320 gelc(k,i)=gelc(k,i)+ghalf
2321 gelc(k,j)=gelc(k,j)+ghalf
2324 * Loop over residues i+1 thru j-1.
2328 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2336 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2337 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2340 * Loop over residues i+1 thru j-1.
2344 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2351 fac=-3*rrmij*(facvdw+facvdw+facel)
2356 * Radial derivatives. First process both termini of the fragment (i,j)
2363 gelc(k,i)=gelc(k,i)+ghalf
2364 gelc(k,j)=gelc(k,j)+ghalf
2367 * Loop over residues i+1 thru j-1.
2371 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2378 ecosa=2.0D0*fac3*fac1+fac4
2381 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2382 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2384 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2385 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2387 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2388 cd & (dcosg(k),k=1,3)
2390 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2394 gelc(k,i)=gelc(k,i)+ghalf
2395 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2396 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2397 gelc(k,j)=gelc(k,j)+ghalf
2398 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2399 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2403 gelc(l,k)=gelc(l,k)+ggg(l)
2407 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2408 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2409 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2411 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2412 C energy of a peptide unit is assumed in the form of a second-order
2413 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2414 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2415 C are computed for EVERY pair of non-contiguous peptide groups.
2417 if (j.lt.nres-1) then
2428 muij(kkk)=mu(k,i)*mu(l,j)
2431 cd write (iout,*) 'EELEC: i',i,' j',j
2432 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2433 cd write(iout,*) 'muij',muij
2434 ury=scalar(uy(1,i),erij)
2435 urz=scalar(uz(1,i),erij)
2436 vry=scalar(uy(1,j),erij)
2437 vrz=scalar(uz(1,j),erij)
2438 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2439 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2440 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2441 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2442 C For diagnostics only
2447 fac=dsqrt(-ael6i)*r3ij
2448 cd write (2,*) 'fac=',fac
2449 C For diagnostics only
2455 cd write (iout,'(4i5,4f10.5)')
2456 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2457 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2458 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2459 cd & uy(:,j),uz(:,j)
2460 cd write (iout,'(4f10.5)')
2461 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2462 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2463 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2464 cd write (iout,'(9f10.5/)')
2465 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2466 C Derivatives of the elements of A in virtual-bond vectors
2467 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2474 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2475 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2476 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2477 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2478 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2479 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2480 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2481 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2482 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2483 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2484 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2485 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2495 C Compute radial contributions to the gradient
2517 C Add the contributions coming from er
2520 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2521 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2522 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2523 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2526 C Derivatives in DC(i)
2527 ghalf1=0.5d0*agg(k,1)
2528 ghalf2=0.5d0*agg(k,2)
2529 ghalf3=0.5d0*agg(k,3)
2530 ghalf4=0.5d0*agg(k,4)
2531 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2532 & -3.0d0*uryg(k,2)*vry)+ghalf1
2533 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2534 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2535 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2536 & -3.0d0*urzg(k,2)*vry)+ghalf3
2537 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2538 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2539 C Derivatives in DC(i+1)
2540 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2541 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2542 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2543 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2544 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2545 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2546 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2547 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2548 C Derivatives in DC(j)
2549 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2550 & -3.0d0*vryg(k,2)*ury)+ghalf1
2551 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2552 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2553 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2554 & -3.0d0*vryg(k,2)*urz)+ghalf3
2555 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2556 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2557 C Derivatives in DC(j+1) or DC(nres-1)
2558 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2559 & -3.0d0*vryg(k,3)*ury)
2560 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2561 & -3.0d0*vrzg(k,3)*ury)
2562 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2563 & -3.0d0*vryg(k,3)*urz)
2564 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2565 & -3.0d0*vrzg(k,3)*urz)
2570 C Derivatives in DC(i+1)
2571 cd aggi1(k,1)=agg(k,1)
2572 cd aggi1(k,2)=agg(k,2)
2573 cd aggi1(k,3)=agg(k,3)
2574 cd aggi1(k,4)=agg(k,4)
2575 C Derivatives in DC(j)
2580 C Derivatives in DC(j+1)
2585 if (j.eq.nres-1 .and. i.lt.j-2) then
2587 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2588 cd aggj1(k,l)=agg(k,l)
2593 C Check the loc-el terms by numerical integration
2603 aggi(k,l)=-aggi(k,l)
2604 aggi1(k,l)=-aggi1(k,l)
2605 aggj(k,l)=-aggj(k,l)
2606 aggj1(k,l)=-aggj1(k,l)
2609 if (j.lt.nres-1) then
2615 aggi(k,l)=-aggi(k,l)
2616 aggi1(k,l)=-aggi1(k,l)
2617 aggj(k,l)=-aggj(k,l)
2618 aggj1(k,l)=-aggj1(k,l)
2629 aggi(k,l)=-aggi(k,l)
2630 aggi1(k,l)=-aggi1(k,l)
2631 aggj(k,l)=-aggj(k,l)
2632 aggj1(k,l)=-aggj1(k,l)
2638 IF (wel_loc.gt.0.0d0) THEN
2639 C Contribution to the local-electrostatic energy coming from the i-j pair
2640 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2642 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2644 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2645 & 'eelloc',i,j,eel_loc_ij
2647 eel_loc=eel_loc+eel_loc_ij
2648 C Partial derivatives in virtual-bond dihedral angles gamma
2650 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2651 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2652 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2653 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2654 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2655 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2656 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2657 cd write(iout,*) 'agg ',agg
2658 cd write(iout,*) 'aggi ',aggi
2659 cd write(iout,*) 'aggi1',aggi1
2660 cd write(iout,*) 'aggj ',aggj
2661 cd write(iout,*) 'aggj1',aggj1
2663 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2665 ggg(l)=agg(l,1)*muij(1)+
2666 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2670 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2673 C Remaining derivatives of eello
2675 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2676 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2677 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2678 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2679 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2680 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2681 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2682 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2685 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2686 C Contributions from turns
2691 call eturn34(i,j,eello_turn3,eello_turn4)
2693 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2694 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2696 C Calculate the contact function. The ith column of the array JCONT will
2697 C contain the numbers of atoms that make contacts with the atom I (of numbers
2698 C greater than I). The arrays FACONT and GACONT will contain the values of
2699 C the contact function and its derivative.
2700 c r0ij=1.02D0*rpp(iteli,itelj)
2701 c r0ij=1.11D0*rpp(iteli,itelj)
2702 r0ij=2.20D0*rpp(iteli,itelj)
2703 c r0ij=1.55D0*rpp(iteli,itelj)
2704 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2705 if (fcont.gt.0.0D0) then
2706 num_conti=num_conti+1
2707 if (num_conti.gt.maxconts) then
2708 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2709 & ' will skip next contacts for this conf.'
2711 jcont_hb(num_conti,i)=j
2712 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2713 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2714 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2716 d_cont(num_conti,i)=rij
2717 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2718 C --- Electrostatic-interaction matrix ---
2719 a_chuj(1,1,num_conti,i)=a22
2720 a_chuj(1,2,num_conti,i)=a23
2721 a_chuj(2,1,num_conti,i)=a32
2722 a_chuj(2,2,num_conti,i)=a33
2723 C --- Gradient of rij
2725 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2728 c a_chuj(1,1,num_conti,i)=-0.61d0
2729 c a_chuj(1,2,num_conti,i)= 0.4d0
2730 c a_chuj(2,1,num_conti,i)= 0.65d0
2731 c a_chuj(2,2,num_conti,i)= 0.50d0
2732 c else if (i.eq.2) then
2733 c a_chuj(1,1,num_conti,i)= 0.0d0
2734 c a_chuj(1,2,num_conti,i)= 0.0d0
2735 c a_chuj(2,1,num_conti,i)= 0.0d0
2736 c a_chuj(2,2,num_conti,i)= 0.0d0
2738 C --- and its gradients
2739 cd write (iout,*) 'i',i,' j',j
2741 cd write (iout,*) 'iii 1 kkk',kkk
2742 cd write (iout,*) agg(kkk,:)
2745 cd write (iout,*) 'iii 2 kkk',kkk
2746 cd write (iout,*) aggi(kkk,:)
2749 cd write (iout,*) 'iii 3 kkk',kkk
2750 cd write (iout,*) aggi1(kkk,:)
2753 cd write (iout,*) 'iii 4 kkk',kkk
2754 cd write (iout,*) aggj(kkk,:)
2757 cd write (iout,*) 'iii 5 kkk',kkk
2758 cd write (iout,*) aggj1(kkk,:)
2765 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2766 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2767 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2768 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2769 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2771 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2777 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2778 C Calculate contact energies
2780 wij=cosa-3.0D0*cosb*cosg
2783 c fac3=dsqrt(-ael6i)/r0ij**3
2784 fac3=dsqrt(-ael6i)*r3ij
2785 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2786 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
2787 if (ees0tmp.gt.0) then
2788 ees0pij=dsqrt(ees0tmp)
2792 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2793 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
2794 if (ees0tmp.gt.0) then
2795 ees0mij=dsqrt(ees0tmp)
2800 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2801 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2802 C Diagnostics. Comment out or remove after debugging!
2803 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2804 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2805 c ees0m(num_conti,i)=0.0D0
2807 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2808 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2809 C Angular derivatives of the contact function
2810 ees0pij1=fac3/ees0pij
2811 ees0mij1=fac3/ees0mij
2812 fac3p=-3.0D0*fac3*rrmij
2813 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2814 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2816 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2817 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2818 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2819 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2820 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2821 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2822 ecosap=ecosa1+ecosa2
2823 ecosbp=ecosb1+ecosb2
2824 ecosgp=ecosg1+ecosg2
2825 ecosam=ecosa1-ecosa2
2826 ecosbm=ecosb1-ecosb2
2827 ecosgm=ecosg1-ecosg2
2836 facont_hb(num_conti,i)=fcont
2837 fprimcont=fprimcont/rij
2838 cd facont_hb(num_conti,i)=1.0D0
2839 C Following line is for diagnostics.
2842 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2843 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2846 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2847 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2849 gggp(1)=gggp(1)+ees0pijp*xj
2850 gggp(2)=gggp(2)+ees0pijp*yj
2851 gggp(3)=gggp(3)+ees0pijp*zj
2852 gggm(1)=gggm(1)+ees0mijp*xj
2853 gggm(2)=gggm(2)+ees0mijp*yj
2854 gggm(3)=gggm(3)+ees0mijp*zj
2855 C Derivatives due to the contact function
2856 gacont_hbr(1,num_conti,i)=fprimcont*xj
2857 gacont_hbr(2,num_conti,i)=fprimcont*yj
2858 gacont_hbr(3,num_conti,i)=fprimcont*zj
2860 ghalfp=0.5D0*gggp(k)
2861 ghalfm=0.5D0*gggm(k)
2862 gacontp_hb1(k,num_conti,i)=ghalfp
2863 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2864 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2865 gacontp_hb2(k,num_conti,i)=ghalfp
2866 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2867 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2868 gacontp_hb3(k,num_conti,i)=gggp(k)
2869 gacontm_hb1(k,num_conti,i)=ghalfm
2870 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2871 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2872 gacontm_hb2(k,num_conti,i)=ghalfm
2873 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2874 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2875 gacontm_hb3(k,num_conti,i)=gggm(k)
2877 C Diagnostics. Comment out or remove after debugging!
2879 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2880 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2881 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2882 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2883 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2884 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2887 endif ! num_conti.le.maxconts
2891 num_cont_hb(i)=num_conti
2893 c write (iout,*) "Number of loop steps in EELEC:",ind
2895 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2896 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2898 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2899 ccc eel_loc=eel_loc+eello_turn3
2902 C-----------------------------------------------------------------------------
2903 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2904 C Third- and fourth-order contributions from turns
2905 implicit real*8 (a-h,o-z)
2906 include 'DIMENSIONS'
2907 include 'COMMON.IOUNITS'
2908 include 'COMMON.GEO'
2909 include 'COMMON.VAR'
2910 include 'COMMON.LOCAL'
2911 include 'COMMON.CHAIN'
2912 include 'COMMON.DERIV'
2913 include 'COMMON.INTERACT'
2914 include 'COMMON.CONTACTS'
2915 include 'COMMON.TORSION'
2916 include 'COMMON.VECTORS'
2917 include 'COMMON.FFIELD'
2918 include 'COMMON.CONTROL'
2920 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2921 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2922 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2923 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2924 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
2925 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2927 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2929 C Third-order contributions
2936 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2937 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2938 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2939 call transpose2(auxmat(1,1),auxmat1(1,1))
2940 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2941 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2942 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2943 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
2944 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2945 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2946 cd & ' eello_turn3_num',4*eello_turn3_num
2947 C Derivatives in gamma(i)
2948 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2949 call transpose2(auxmat2(1,1),auxmat3(1,1))
2950 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
2951 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2952 C Derivatives in gamma(i+1)
2953 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2954 call transpose2(auxmat2(1,1),auxmat3(1,1))
2955 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
2956 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2957 & +0.5d0*(pizda(1,1)+pizda(2,2))
2958 C Cartesian derivatives
2960 a_temp(1,1)=aggi(l,1)
2961 a_temp(1,2)=aggi(l,2)
2962 a_temp(2,1)=aggi(l,3)
2963 a_temp(2,2)=aggi(l,4)
2964 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2965 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2966 & +0.5d0*(pizda(1,1)+pizda(2,2))
2967 a_temp(1,1)=aggi1(l,1)
2968 a_temp(1,2)=aggi1(l,2)
2969 a_temp(2,1)=aggi1(l,3)
2970 a_temp(2,2)=aggi1(l,4)
2971 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2972 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2973 & +0.5d0*(pizda(1,1)+pizda(2,2))
2974 a_temp(1,1)=aggj(l,1)
2975 a_temp(1,2)=aggj(l,2)
2976 a_temp(2,1)=aggj(l,3)
2977 a_temp(2,2)=aggj(l,4)
2978 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2979 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2980 & +0.5d0*(pizda(1,1)+pizda(2,2))
2981 a_temp(1,1)=aggj1(l,1)
2982 a_temp(1,2)=aggj1(l,2)
2983 a_temp(2,1)=aggj1(l,3)
2984 a_temp(2,2)=aggj1(l,4)
2985 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2986 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2987 & +0.5d0*(pizda(1,1)+pizda(2,2))
2989 else if (j.eq.i+3) then
2990 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2992 C Fourth-order contributions
3000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3001 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3002 iti1=itortyp(itype(i+1))
3003 iti2=itortyp(itype(i+2))
3004 iti3=itortyp(itype(i+3))
3005 call transpose2(EUg(1,1,i+1),e1t(1,1))
3006 call transpose2(Eug(1,1,i+2),e2t(1,1))
3007 call transpose2(Eug(1,1,i+3),e3t(1,1))
3008 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3009 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3010 s1=scalar2(b1(1,iti2),auxvec(1))
3011 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3012 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3013 s2=scalar2(b1(1,iti1),auxvec(1))
3014 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3015 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3016 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3017 eello_turn4=eello_turn4-(s1+s2+s3)
3018 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3019 & 'eturn4',i,j,-(s1+s2+s3)
3020 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3021 cd & ' eello_turn4_num',8*eello_turn4_num
3022 C Derivatives in gamma(i)
3023 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3024 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3025 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3026 s1=scalar2(b1(1,iti2),auxvec(1))
3027 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3028 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3029 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3030 C Derivatives in gamma(i+1)
3031 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3032 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3033 s2=scalar2(b1(1,iti1),auxvec(1))
3034 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3035 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3036 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3037 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3038 C Derivatives in gamma(i+2)
3039 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3040 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3041 s1=scalar2(b1(1,iti2),auxvec(1))
3042 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3043 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3044 s2=scalar2(b1(1,iti1),auxvec(1))
3045 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3046 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3047 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3048 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3049 C Cartesian derivatives
3050 C Derivatives of this turn contributions in DC(i+2)
3051 if (j.lt.nres-1) then
3053 a_temp(1,1)=agg(l,1)
3054 a_temp(1,2)=agg(l,2)
3055 a_temp(2,1)=agg(l,3)
3056 a_temp(2,2)=agg(l,4)
3057 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3058 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3059 s1=scalar2(b1(1,iti2),auxvec(1))
3060 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3061 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3062 s2=scalar2(b1(1,iti1),auxvec(1))
3063 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3064 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3065 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3067 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3070 C Remaining derivatives of this turn contribution
3072 a_temp(1,1)=aggi(l,1)
3073 a_temp(1,2)=aggi(l,2)
3074 a_temp(2,1)=aggi(l,3)
3075 a_temp(2,2)=aggi(l,4)
3076 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3077 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3078 s1=scalar2(b1(1,iti2),auxvec(1))
3079 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3080 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3081 s2=scalar2(b1(1,iti1),auxvec(1))
3082 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3083 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3084 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3085 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3086 a_temp(1,1)=aggi1(l,1)
3087 a_temp(1,2)=aggi1(l,2)
3088 a_temp(2,1)=aggi1(l,3)
3089 a_temp(2,2)=aggi1(l,4)
3090 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3091 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3092 s1=scalar2(b1(1,iti2),auxvec(1))
3093 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3094 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3095 s2=scalar2(b1(1,iti1),auxvec(1))
3096 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3097 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3098 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3099 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3100 a_temp(1,1)=aggj(l,1)
3101 a_temp(1,2)=aggj(l,2)
3102 a_temp(2,1)=aggj(l,3)
3103 a_temp(2,2)=aggj(l,4)
3104 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3105 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3106 s1=scalar2(b1(1,iti2),auxvec(1))
3107 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3108 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3109 s2=scalar2(b1(1,iti1),auxvec(1))
3110 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3111 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3112 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3113 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3114 a_temp(1,1)=aggj1(l,1)
3115 a_temp(1,2)=aggj1(l,2)
3116 a_temp(2,1)=aggj1(l,3)
3117 a_temp(2,2)=aggj1(l,4)
3118 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3119 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3120 s1=scalar2(b1(1,iti2),auxvec(1))
3121 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3122 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3123 s2=scalar2(b1(1,iti1),auxvec(1))
3124 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3125 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3126 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3127 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3132 C-----------------------------------------------------------------------------
3133 subroutine vecpr(u,v,w)
3134 implicit real*8(a-h,o-z)
3135 dimension u(3),v(3),w(3)
3136 w(1)=u(2)*v(3)-u(3)*v(2)
3137 w(2)=-u(1)*v(3)+u(3)*v(1)
3138 w(3)=u(1)*v(2)-u(2)*v(1)
3141 C-----------------------------------------------------------------------------
3142 subroutine unormderiv(u,ugrad,unorm,ungrad)
3143 C This subroutine computes the derivatives of a normalized vector u, given
3144 C the derivatives computed without normalization conditions, ugrad. Returns
3147 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3148 double precision vec(3)
3149 double precision scalar
3151 c write (2,*) 'ugrad',ugrad
3154 vec(i)=scalar(ugrad(1,i),u(1))
3156 c write (2,*) 'vec',vec
3159 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3162 c write (2,*) 'ungrad',ungrad
3165 C-----------------------------------------------------------------------------
3166 subroutine escp_soft_sphere(evdw2,evdw2_14)
3168 C This subroutine calculates the excluded-volume interaction energy between
3169 C peptide-group centers and side chains and its gradient in virtual-bond and
3170 C side-chain vectors.
3172 implicit real*8 (a-h,o-z)
3173 include 'DIMENSIONS'
3174 include 'COMMON.GEO'
3175 include 'COMMON.VAR'
3176 include 'COMMON.LOCAL'
3177 include 'COMMON.CHAIN'
3178 include 'COMMON.DERIV'
3179 include 'COMMON.INTERACT'
3180 include 'COMMON.FFIELD'
3181 include 'COMMON.IOUNITS'
3182 include 'COMMON.CONTROL'
3187 cd print '(a)','Enter ESCP'
3188 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3189 do i=iatscp_s,iatscp_e
3191 xi=0.5D0*(c(1,i)+c(1,i+1))
3192 yi=0.5D0*(c(2,i)+c(2,i+1))
3193 zi=0.5D0*(c(3,i)+c(3,i+1))
3195 do iint=1,nscp_gr(i)
3197 do j=iscpstart(i,iint),iscpend(i,iint)
3199 C Uncomment following three lines for SC-p interactions
3203 C Uncomment following three lines for Ca-p interactions
3207 rij=xj*xj+yj*yj+zj*zj
3210 if (rij.lt.r0ijsq) then
3211 evdwij=0.25d0*(rij-r0ijsq)**2
3219 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3225 cd write (iout,*) 'j<i'
3226 C Uncomment following three lines for SC-p interactions
3228 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3231 cd write (iout,*) 'j>i'
3234 C Uncomment following line for SC-p interactions
3235 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3239 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3243 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3244 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3247 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3256 C-----------------------------------------------------------------------------
3257 subroutine escp(evdw2,evdw2_14)
3259 C This subroutine calculates the excluded-volume interaction energy between
3260 C peptide-group centers and side chains and its gradient in virtual-bond and
3261 C side-chain vectors.
3263 implicit real*8 (a-h,o-z)
3264 include 'DIMENSIONS'
3265 include 'COMMON.GEO'
3266 include 'COMMON.VAR'
3267 include 'COMMON.LOCAL'
3268 include 'COMMON.CHAIN'
3269 include 'COMMON.DERIV'
3270 include 'COMMON.INTERACT'
3271 include 'COMMON.FFIELD'
3272 include 'COMMON.IOUNITS'
3273 include 'COMMON.CONTROL'
3277 cd print '(a)','Enter ESCP'
3278 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3279 do i=iatscp_s,iatscp_e
3281 xi=0.5D0*(c(1,i)+c(1,i+1))
3282 yi=0.5D0*(c(2,i)+c(2,i+1))
3283 zi=0.5D0*(c(3,i)+c(3,i+1))
3285 do iint=1,nscp_gr(i)
3287 do j=iscpstart(i,iint),iscpend(i,iint)
3289 C Uncomment following three lines for SC-p interactions
3293 C Uncomment following three lines for Ca-p interactions
3297 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3299 e1=fac*fac*aad(itypj,iteli)
3300 e2=fac*bad(itypj,iteli)
3301 if (iabs(j-i) .le. 2) then
3304 evdw2_14=evdw2_14+e1+e2
3308 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3309 & 'evdw2',i,j,evdwij
3311 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3313 fac=-(evdwij+e1)*rrij
3318 cd write (iout,*) 'j<i'
3319 C Uncomment following three lines for SC-p interactions
3321 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3324 cd write (iout,*) 'j>i'
3327 C Uncomment following line for SC-p interactions
3328 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3332 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3336 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3337 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3338 cgrad do k=kstart,kend
3340 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3349 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3350 gradx_scp(j,i)=expon*gradx_scp(j,i)
3353 C******************************************************************************
3357 C To save time the factor EXPON has been extracted from ALL components
3358 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3361 C******************************************************************************
3364 C--------------------------------------------------------------------------
3365 subroutine edis(ehpb)
3367 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3369 implicit real*8 (a-h,o-z)
3370 include 'DIMENSIONS'
3371 include 'COMMON.SBRIDGE'
3372 include 'COMMON.CHAIN'
3373 include 'COMMON.DERIV'
3374 include 'COMMON.VAR'
3375 include 'COMMON.INTERACT'
3378 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3379 cd print *,'link_start=',link_start,' link_end=',link_end
3380 if (link_end.eq.0) return
3381 do i=link_start,link_end
3382 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3383 C CA-CA distance used in regularization of structure.
3386 C iii and jjj point to the residues for which the distance is assigned.
3387 if (ii.gt.nres) then
3394 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3395 C distance and angle dependent SS bond potential.
3396 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3397 call ssbond_ene(iii,jjj,eij)
3400 C Calculate the distance between the two points and its difference from the
3404 C Get the force constant corresponding to this distance.
3406 C Calculate the contribution to energy.
3407 ehpb=ehpb+waga*rdis*rdis
3409 C Evaluate gradient.
3412 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3413 cd & ' waga=',waga,' fac=',fac
3415 ggg(j)=fac*(c(j,jj)-c(j,ii))
3417 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3418 C If this is a SC-SC distance, we need to calculate the contributions to the
3419 C Cartesian gradient in the SC vectors (ghpbx).
3422 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3423 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3428 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3436 C--------------------------------------------------------------------------
3437 subroutine ssbond_ene(i,j,eij)
3439 C Calculate the distance and angle dependent SS-bond potential energy
3440 C using a free-energy function derived based on RHF/6-31G** ab initio
3441 C calculations of diethyl disulfide.
3443 C A. Liwo and U. Kozlowska, 11/24/03
3445 implicit real*8 (a-h,o-z)
3446 include 'DIMENSIONS'
3447 include 'COMMON.SBRIDGE'
3448 include 'COMMON.CHAIN'
3449 include 'COMMON.DERIV'
3450 include 'COMMON.LOCAL'
3451 include 'COMMON.INTERACT'
3452 include 'COMMON.VAR'
3453 include 'COMMON.IOUNITS'
3454 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3459 dxi=dc_norm(1,nres+i)
3460 dyi=dc_norm(2,nres+i)
3461 dzi=dc_norm(3,nres+i)
3462 dsci_inv=dsc_inv(itypi)
3464 dscj_inv=dsc_inv(itypj)
3468 dxj=dc_norm(1,nres+j)
3469 dyj=dc_norm(2,nres+j)
3470 dzj=dc_norm(3,nres+j)
3471 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3476 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3477 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3478 om12=dxi*dxj+dyi*dyj+dzi*dzj
3480 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3481 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3487 deltat12=om2-om1+2.0d0
3489 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3490 & +akct*deltad*deltat12
3491 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3492 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3493 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3494 c & " deltat12",deltat12," eij",eij
3495 ed=2*akcm*deltad+akct*deltat12
3497 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3498 eom1=-2*akth*deltat1-pom1-om2*pom2
3499 eom2= 2*akth*deltat2+pom1-om1*pom2
3502 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3505 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3506 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3507 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3508 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3511 C Calculate the components of the gradient in DC and X
3515 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3520 C--------------------------------------------------------------------------
3521 subroutine ebond(estr)
3523 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3525 implicit real*8 (a-h,o-z)
3526 include 'DIMENSIONS'
3527 include 'COMMON.LOCAL'
3528 include 'COMMON.GEO'
3529 include 'COMMON.INTERACT'
3530 include 'COMMON.DERIV'
3531 include 'COMMON.VAR'
3532 include 'COMMON.CHAIN'
3533 include 'COMMON.IOUNITS'
3534 include 'COMMON.NAMES'
3535 include 'COMMON.FFIELD'
3536 include 'COMMON.CONTROL'
3537 include 'COMMON.SETUP'
3538 double precision u(3),ud(3)
3540 do i=ibondp_start,ibondp_end
3541 diff = vbld(i)-vbldp0
3542 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3545 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3547 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
3551 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3553 do i=ibond_start,ibond_end
3558 diff=vbld(i+nres)-vbldsc0(1,iti)
3559 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3560 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3561 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3563 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3567 diff=vbld(i+nres)-vbldsc0(j,iti)
3568 ud(j)=aksc(j,iti)*diff
3569 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3583 uprod2=uprod2*u(k)*u(k)
3587 usumsqder=usumsqder+ud(j)*uprod2
3589 estr=estr+uprod/usum
3591 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3599 C--------------------------------------------------------------------------
3600 subroutine ebend(etheta)
3602 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3603 C angles gamma and its derivatives in consecutive thetas and gammas.
3605 implicit real*8 (a-h,o-z)
3606 include 'DIMENSIONS'
3607 include 'COMMON.LOCAL'
3608 include 'COMMON.GEO'
3609 include 'COMMON.INTERACT'
3610 include 'COMMON.DERIV'
3611 include 'COMMON.VAR'
3612 include 'COMMON.CHAIN'
3613 include 'COMMON.IOUNITS'
3614 include 'COMMON.NAMES'
3615 include 'COMMON.FFIELD'
3616 include 'COMMON.CONTROL'
3617 common /calcthet/ term1,term2,termm,diffak,ratak,
3618 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3619 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3620 double precision y(2),z(2)
3622 c time11=dexp(-2*time)
3625 c write (*,'(a,i2)') 'EBEND ICG=',icg
3626 do i=ithet_start,ithet_end
3627 C Zero the energy function and its derivative at 0 or pi.
3628 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3633 if (phii.ne.phii) phii=150.0
3646 if (phii1.ne.phii1) phii1=150.0
3658 C Calculate the "mean" value of theta from the part of the distribution
3659 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3660 C In following comments this theta will be referred to as t_c.
3661 thet_pred_mean=0.0d0
3665 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3667 dthett=thet_pred_mean*ssd
3668 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3669 C Derivatives of the "mean" values in gamma1 and gamma2.
3670 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3671 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3672 if (theta(i).gt.pi-delta) then
3673 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3675 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3676 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3677 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3679 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3681 else if (theta(i).lt.delta) then
3682 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3683 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3684 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3686 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3687 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3690 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3693 etheta=etheta+ethetai
3694 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
3696 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3697 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3698 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3700 C Ufff.... We've done all this!!!
3703 C---------------------------------------------------------------------------
3704 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3706 implicit real*8 (a-h,o-z)
3707 include 'DIMENSIONS'
3708 include 'COMMON.LOCAL'
3709 include 'COMMON.IOUNITS'
3710 common /calcthet/ term1,term2,termm,diffak,ratak,
3711 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3712 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3713 C Calculate the contributions to both Gaussian lobes.
3714 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3715 C The "polynomial part" of the "standard deviation" of this part of
3719 sig=sig*thet_pred_mean+polthet(j,it)
3721 C Derivative of the "interior part" of the "standard deviation of the"
3722 C gamma-dependent Gaussian lobe in t_c.
3723 sigtc=3*polthet(3,it)
3725 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3728 C Set the parameters of both Gaussian lobes of the distribution.
3729 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3730 fac=sig*sig+sigc0(it)
3733 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3734 sigsqtc=-4.0D0*sigcsq*sigtc
3735 c print *,i,sig,sigtc,sigsqtc
3736 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3737 sigtc=-sigtc/(fac*fac)
3738 C Following variable is sigma(t_c)**(-2)
3739 sigcsq=sigcsq*sigcsq
3741 sig0inv=1.0D0/sig0i**2
3742 delthec=thetai-thet_pred_mean
3743 delthe0=thetai-theta0i
3744 term1=-0.5D0*sigcsq*delthec*delthec
3745 term2=-0.5D0*sig0inv*delthe0*delthe0
3746 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3747 C NaNs in taking the logarithm. We extract the largest exponent which is added
3748 C to the energy (this being the log of the distribution) at the end of energy
3749 C term evaluation for this virtual-bond angle.
3750 if (term1.gt.term2) then
3752 term2=dexp(term2-termm)
3756 term1=dexp(term1-termm)
3759 C The ratio between the gamma-independent and gamma-dependent lobes of
3760 C the distribution is a Gaussian function of thet_pred_mean too.
3761 diffak=gthet(2,it)-thet_pred_mean
3762 ratak=diffak/gthet(3,it)**2
3763 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3764 C Let's differentiate it in thet_pred_mean NOW.
3766 C Now put together the distribution terms to make complete distribution.
3767 termexp=term1+ak*term2
3768 termpre=sigc+ak*sig0i
3769 C Contribution of the bending energy from this theta is just the -log of
3770 C the sum of the contributions from the two lobes and the pre-exponential
3771 C factor. Simple enough, isn't it?
3772 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3773 C NOW the derivatives!!!
3774 C 6/6/97 Take into account the deformation.
3775 E_theta=(delthec*sigcsq*term1
3776 & +ak*delthe0*sig0inv*term2)/termexp
3777 E_tc=((sigtc+aktc*sig0i)/termpre
3778 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3779 & aktc*term2)/termexp)
3782 c-----------------------------------------------------------------------------
3783 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3784 implicit real*8 (a-h,o-z)
3785 include 'DIMENSIONS'
3786 include 'COMMON.LOCAL'
3787 include 'COMMON.IOUNITS'
3788 common /calcthet/ term1,term2,termm,diffak,ratak,
3789 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3790 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3791 delthec=thetai-thet_pred_mean
3792 delthe0=thetai-theta0i
3793 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3794 t3 = thetai-thet_pred_mean
3798 t14 = t12+t6*sigsqtc
3800 t21 = thetai-theta0i
3806 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3807 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3808 & *(-t12*t9-ak*sig0inv*t27)
3812 C--------------------------------------------------------------------------
3813 subroutine ebend(etheta)
3815 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3816 C angles gamma and its derivatives in consecutive thetas and gammas.
3817 C ab initio-derived potentials from
3818 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3820 implicit real*8 (a-h,o-z)
3821 include 'DIMENSIONS'
3822 include 'COMMON.LOCAL'
3823 include 'COMMON.GEO'
3824 include 'COMMON.INTERACT'
3825 include 'COMMON.DERIV'
3826 include 'COMMON.VAR'
3827 include 'COMMON.CHAIN'
3828 include 'COMMON.IOUNITS'
3829 include 'COMMON.NAMES'
3830 include 'COMMON.FFIELD'
3831 include 'COMMON.CONTROL'
3832 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3833 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3834 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3835 & sinph1ph2(maxdouble,maxdouble)
3836 logical lprn /.false./, lprn1 /.false./
3838 do i=ithet_start,ithet_end
3842 theti2=0.5d0*theta(i)
3843 ityp2=ithetyp(itype(i-1))
3845 coskt(k)=dcos(k*theti2)
3846 sinkt(k)=dsin(k*theti2)
3851 if (phii.ne.phii) phii=150.0
3855 ityp1=ithetyp(itype(i-2))
3857 cosph1(k)=dcos(k*phii)
3858 sinph1(k)=dsin(k*phii)
3871 if (phii1.ne.phii1) phii1=150.0
3876 ityp3=ithetyp(itype(i))
3878 cosph2(k)=dcos(k*phii1)
3879 sinph2(k)=dsin(k*phii1)
3889 ethetai=aa0thet(ityp1,ityp2,ityp3)
3892 ccl=cosph1(l)*cosph2(k-l)
3893 ssl=sinph1(l)*sinph2(k-l)
3894 scl=sinph1(l)*cosph2(k-l)
3895 csl=cosph1(l)*sinph2(k-l)
3896 cosph1ph2(l,k)=ccl-ssl
3897 cosph1ph2(k,l)=ccl+ssl
3898 sinph1ph2(l,k)=scl+csl
3899 sinph1ph2(k,l)=scl-csl
3903 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3904 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3905 write (iout,*) "coskt and sinkt"
3907 write (iout,*) k,coskt(k),sinkt(k)
3911 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3912 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3915 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3916 & " ethetai",ethetai
3919 write (iout,*) "cosph and sinph"
3921 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3923 write (iout,*) "cosph1ph2 and sinph2ph2"
3926 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3927 & sinph1ph2(l,k),sinph1ph2(k,l)
3930 write(iout,*) "ethetai",ethetai
3934 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3935 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3936 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3937 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3938 ethetai=ethetai+sinkt(m)*aux
3939 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3940 dephii=dephii+k*sinkt(m)*(
3941 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3942 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3943 dephii1=dephii1+k*sinkt(m)*(
3944 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3945 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3947 & write (iout,*) "m",m," k",k," bbthet",
3948 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3949 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3950 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3951 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3955 & write(iout,*) "ethetai",ethetai
3959 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3960 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3961 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3962 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3963 ethetai=ethetai+sinkt(m)*aux
3964 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3965 dephii=dephii+l*sinkt(m)*(
3966 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3967 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3968 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3969 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3970 dephii1=dephii1+(k-l)*sinkt(m)*(
3971 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3972 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3973 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3974 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3976 write (iout,*) "m",m," k",k," l",l," ffthet",
3977 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3978 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3979 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3980 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3981 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3982 & cosph1ph2(k,l)*sinkt(m),
3983 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3989 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3990 & i,theta(i)*rad2deg,phii*rad2deg,
3991 & phii1*rad2deg,ethetai
3992 etheta=etheta+ethetai
3993 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3994 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3995 gloc(nphi+i-2,icg)=wang*dethetai
4001 c-----------------------------------------------------------------------------
4002 subroutine esc(escloc)
4003 C Calculate the local energy of a side chain and its derivatives in the
4004 C corresponding virtual-bond valence angles THETA and the spherical angles
4006 implicit real*8 (a-h,o-z)
4007 include 'DIMENSIONS'
4008 include 'COMMON.GEO'
4009 include 'COMMON.LOCAL'
4010 include 'COMMON.VAR'
4011 include 'COMMON.INTERACT'
4012 include 'COMMON.DERIV'
4013 include 'COMMON.CHAIN'
4014 include 'COMMON.IOUNITS'
4015 include 'COMMON.NAMES'
4016 include 'COMMON.FFIELD'
4017 include 'COMMON.CONTROL'
4018 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4019 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4020 common /sccalc/ time11,time12,time112,theti,it,nlobit
4023 c write (iout,'(a)') 'ESC'
4024 do i=loc_start,loc_end
4026 if (it.eq.10) goto 1
4028 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4029 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4030 theti=theta(i+1)-pipol
4035 if (x(2).gt.pi-delta) then
4039 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4041 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4042 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4044 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4045 & ddersc0(1),dersc(1))
4046 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4047 & ddersc0(3),dersc(3))
4049 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4051 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4052 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4053 & dersc0(2),esclocbi,dersc02)
4054 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4056 call splinthet(x(2),0.5d0*delta,ss,ssd)
4061 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4063 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4064 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4066 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4068 c write (iout,*) escloci
4069 else if (x(2).lt.delta) then
4073 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4075 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4076 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4078 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4079 & ddersc0(1),dersc(1))
4080 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4081 & ddersc0(3),dersc(3))
4083 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4085 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4086 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4087 & dersc0(2),esclocbi,dersc02)
4088 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4093 call splinthet(x(2),0.5d0*delta,ss,ssd)
4095 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4097 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4098 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4100 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4101 c write (iout,*) escloci
4103 call enesc(x,escloci,dersc,ddummy,.false.)
4106 escloc=escloc+escloci
4107 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4108 & 'escloc',i,escloci
4109 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4111 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4113 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4114 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4119 C---------------------------------------------------------------------------
4120 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4121 implicit real*8 (a-h,o-z)
4122 include 'DIMENSIONS'
4123 include 'COMMON.GEO'
4124 include 'COMMON.LOCAL'
4125 include 'COMMON.IOUNITS'
4126 common /sccalc/ time11,time12,time112,theti,it,nlobit
4127 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4128 double precision contr(maxlob,-1:1)
4130 c write (iout,*) 'it=',it,' nlobit=',nlobit
4134 if (mixed) ddersc(j)=0.0d0
4138 C Because of periodicity of the dependence of the SC energy in omega we have
4139 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4140 C To avoid underflows, first compute & store the exponents.
4148 z(k)=x(k)-censc(k,j,it)
4153 Axk=Axk+gaussc(l,k,j,it)*z(l)
4159 expfac=expfac+Ax(k,j,iii)*z(k)
4167 C As in the case of ebend, we want to avoid underflows in exponentiation and
4168 C subsequent NaNs and INFs in energy calculation.
4169 C Find the largest exponent
4173 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4177 cd print *,'it=',it,' emin=',emin
4179 C Compute the contribution to SC energy and derivatives
4184 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4185 if(adexp.ne.adexp) adexp=1.0
4188 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4190 cd print *,'j=',j,' expfac=',expfac
4191 escloc_i=escloc_i+expfac
4193 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4197 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4198 & +gaussc(k,2,j,it))*expfac
4205 dersc(1)=dersc(1)/cos(theti)**2
4206 ddersc(1)=ddersc(1)/cos(theti)**2
4209 escloci=-(dlog(escloc_i)-emin)
4211 dersc(j)=dersc(j)/escloc_i
4215 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4220 C------------------------------------------------------------------------------
4221 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4222 implicit real*8 (a-h,o-z)
4223 include 'DIMENSIONS'
4224 include 'COMMON.GEO'
4225 include 'COMMON.LOCAL'
4226 include 'COMMON.IOUNITS'
4227 common /sccalc/ time11,time12,time112,theti,it,nlobit
4228 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4229 double precision contr(maxlob)
4240 z(k)=x(k)-censc(k,j,it)
4246 Axk=Axk+gaussc(l,k,j,it)*z(l)
4252 expfac=expfac+Ax(k,j)*z(k)
4257 C As in the case of ebend, we want to avoid underflows in exponentiation and
4258 C subsequent NaNs and INFs in energy calculation.
4259 C Find the largest exponent
4262 if (emin.gt.contr(j)) emin=contr(j)
4266 C Compute the contribution to SC energy and derivatives
4270 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4271 escloc_i=escloc_i+expfac
4273 dersc(k)=dersc(k)+Ax(k,j)*expfac
4275 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4276 & +gaussc(1,2,j,it))*expfac
4280 dersc(1)=dersc(1)/cos(theti)**2
4281 dersc12=dersc12/cos(theti)**2
4282 escloci=-(dlog(escloc_i)-emin)
4284 dersc(j)=dersc(j)/escloc_i
4286 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4290 c----------------------------------------------------------------------------------
4291 subroutine esc(escloc)
4292 C Calculate the local energy of a side chain and its derivatives in the
4293 C corresponding virtual-bond valence angles THETA and the spherical angles
4294 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4295 C added by Urszula Kozlowska. 07/11/2007
4297 implicit real*8 (a-h,o-z)
4298 include 'DIMENSIONS'
4299 include 'COMMON.GEO'
4300 include 'COMMON.LOCAL'
4301 include 'COMMON.VAR'
4302 include 'COMMON.SCROT'
4303 include 'COMMON.INTERACT'
4304 include 'COMMON.DERIV'
4305 include 'COMMON.CHAIN'
4306 include 'COMMON.IOUNITS'
4307 include 'COMMON.NAMES'
4308 include 'COMMON.FFIELD'
4309 include 'COMMON.CONTROL'
4310 include 'COMMON.VECTORS'
4311 double precision x_prime(3),y_prime(3),z_prime(3)
4312 & , sumene,dsc_i,dp2_i,x(65),
4313 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4314 & de_dxx,de_dyy,de_dzz,de_dt
4315 double precision s1_t,s1_6_t,s2_t,s2_6_t
4317 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4318 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4319 & dt_dCi(3),dt_dCi1(3)
4320 common /sccalc/ time11,time12,time112,theti,it,nlobit
4323 do i=loc_start,loc_end
4324 costtab(i+1) =dcos(theta(i+1))
4325 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4326 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4327 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4328 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4329 cosfac=dsqrt(cosfac2)
4330 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4331 sinfac=dsqrt(sinfac2)
4333 if (it.eq.10) goto 1
4335 C Compute the axes of tghe local cartesian coordinates system; store in
4336 c x_prime, y_prime and z_prime
4343 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4344 C & dc_norm(3,i+nres)
4346 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4347 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4350 z_prime(j) = -uz(j,i-1)
4353 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4354 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4355 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4356 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4357 c & " xy",scalar(x_prime(1),y_prime(1)),
4358 c & " xz",scalar(x_prime(1),z_prime(1)),
4359 c & " yy",scalar(y_prime(1),y_prime(1)),
4360 c & " yz",scalar(y_prime(1),z_prime(1)),
4361 c & " zz",scalar(z_prime(1),z_prime(1))
4363 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4364 C to local coordinate system. Store in xx, yy, zz.
4370 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4371 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4372 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4379 C Compute the energy of the ith side cbain
4381 c write (2,*) "xx",xx," yy",yy," zz",zz
4384 x(j) = sc_parmin(j,it)
4387 Cc diagnostics - remove later
4389 yy1 = dsin(alph(2))*dcos(omeg(2))
4390 zz1 = -dsin(alph(2))*dsin(omeg(2))
4391 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4392 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4394 C," --- ", xx_w,yy_w,zz_w
4397 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4398 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4400 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4401 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4403 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4404 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4405 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4406 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4407 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4409 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4410 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4411 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4412 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4413 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4415 dsc_i = 0.743d0+x(61)
4417 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4418 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4419 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4420 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4421 s1=(1+x(63))/(0.1d0 + dscp1)
4422 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4423 s2=(1+x(65))/(0.1d0 + dscp2)
4424 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4425 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4426 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4427 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4429 c & dscp1,dscp2,sumene
4430 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4431 escloc = escloc + sumene
4432 c write (2,*) "i",i," escloc",sumene,escloc
4435 C This section to check the numerical derivatives of the energy of ith side
4436 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4437 C #define DEBUG in the code to turn it on.
4439 write (2,*) "sumene =",sumene
4443 write (2,*) xx,yy,zz
4444 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4445 de_dxx_num=(sumenep-sumene)/aincr
4447 write (2,*) "xx+ sumene from enesc=",sumenep
4450 write (2,*) xx,yy,zz
4451 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4452 de_dyy_num=(sumenep-sumene)/aincr
4454 write (2,*) "yy+ sumene from enesc=",sumenep
4457 write (2,*) xx,yy,zz
4458 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4459 de_dzz_num=(sumenep-sumene)/aincr
4461 write (2,*) "zz+ sumene from enesc=",sumenep
4462 costsave=cost2tab(i+1)
4463 sintsave=sint2tab(i+1)
4464 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4465 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4466 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4467 de_dt_num=(sumenep-sumene)/aincr
4468 write (2,*) " t+ sumene from enesc=",sumenep
4469 cost2tab(i+1)=costsave
4470 sint2tab(i+1)=sintsave
4471 C End of diagnostics section.
4474 C Compute the gradient of esc
4476 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4477 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4478 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4479 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4480 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4481 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4482 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4483 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4484 pom1=(sumene3*sint2tab(i+1)+sumene1)
4485 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4486 pom2=(sumene4*cost2tab(i+1)+sumene2)
4487 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4488 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4489 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4490 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4492 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4493 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4494 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4496 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4497 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4498 & +(pom1+pom2)*pom_dx
4500 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4503 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4504 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4505 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4507 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4508 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4509 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4510 & +x(59)*zz**2 +x(60)*xx*zz
4511 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4512 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4513 & +(pom1-pom2)*pom_dy
4515 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4518 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4519 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4520 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4521 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4522 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4523 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4524 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4525 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4527 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4530 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4531 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4532 & +pom1*pom_dt1+pom2*pom_dt2
4534 write(2,*), "de_dt = ", de_dt,de_dt_num
4538 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4539 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4540 cosfac2xx=cosfac2*xx
4541 sinfac2yy=sinfac2*yy
4543 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4545 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4547 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4548 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4549 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4550 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4551 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4552 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4553 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4554 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4555 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4556 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4560 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4561 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4564 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4565 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4566 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4568 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4569 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4573 dXX_Ctab(k,i)=dXX_Ci(k)
4574 dXX_C1tab(k,i)=dXX_Ci1(k)
4575 dYY_Ctab(k,i)=dYY_Ci(k)
4576 dYY_C1tab(k,i)=dYY_Ci1(k)
4577 dZZ_Ctab(k,i)=dZZ_Ci(k)
4578 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4579 dXX_XYZtab(k,i)=dXX_XYZ(k)
4580 dYY_XYZtab(k,i)=dYY_XYZ(k)
4581 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4585 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4586 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4587 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4588 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4589 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4591 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4592 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4593 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4594 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4595 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4596 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4597 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4598 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4600 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4601 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4603 C to check gradient call subroutine check_grad
4609 c------------------------------------------------------------------------------
4610 double precision function enesc(x,xx,yy,zz,cost2,sint2)
4612 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
4613 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
4614 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4615 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4617 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4618 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4620 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4621 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4622 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4623 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4624 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4626 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4627 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4628 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4629 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4630 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4632 dsc_i = 0.743d0+x(61)
4634 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4635 & *(xx*cost2+yy*sint2))
4636 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4637 & *(xx*cost2-yy*sint2))
4638 s1=(1+x(63))/(0.1d0 + dscp1)
4639 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4640 s2=(1+x(65))/(0.1d0 + dscp2)
4641 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4642 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
4643 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
4648 c------------------------------------------------------------------------------
4649 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4651 C This procedure calculates two-body contact function g(rij) and its derivative:
4654 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4657 C where x=(rij-r0ij)/delta
4659 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4662 double precision rij,r0ij,eps0ij,fcont,fprimcont
4663 double precision x,x2,x4,delta
4667 if (x.lt.-1.0D0) then
4670 else if (x.le.1.0D0) then
4673 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4674 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4681 c------------------------------------------------------------------------------
4682 subroutine splinthet(theti,delta,ss,ssder)
4683 implicit real*8 (a-h,o-z)
4684 include 'DIMENSIONS'
4685 include 'COMMON.VAR'
4686 include 'COMMON.GEO'
4689 if (theti.gt.pipol) then
4690 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4692 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4697 c------------------------------------------------------------------------------
4698 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4700 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4701 double precision ksi,ksi2,ksi3,a1,a2,a3
4702 a1=fprim0*delta/(f1-f0)
4708 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4709 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4712 c------------------------------------------------------------------------------
4713 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4715 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4716 double precision ksi,ksi2,ksi3,a1,a2,a3
4721 a2=3*(f1x-f0x)-2*fprim0x*delta
4722 a3=fprim0x*delta-2*(f1x-f0x)
4723 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4726 C-----------------------------------------------------------------------------
4728 C-----------------------------------------------------------------------------
4729 subroutine etor(etors,edihcnstr)
4730 implicit real*8 (a-h,o-z)
4731 include 'DIMENSIONS'
4732 include 'COMMON.VAR'
4733 include 'COMMON.GEO'
4734 include 'COMMON.LOCAL'
4735 include 'COMMON.TORSION'
4736 include 'COMMON.INTERACT'
4737 include 'COMMON.DERIV'
4738 include 'COMMON.CHAIN'
4739 include 'COMMON.NAMES'
4740 include 'COMMON.IOUNITS'
4741 include 'COMMON.FFIELD'
4742 include 'COMMON.TORCNSTR'
4743 include 'COMMON.CONTROL'
4745 C Set lprn=.true. for debugging
4749 do i=iphi_start,iphi_end
4751 itori=itortyp(itype(i-2))
4752 itori1=itortyp(itype(i-1))
4755 C Proline-Proline pair is a special case...
4756 if (itori.eq.3 .and. itori1.eq.3) then
4757 if (phii.gt.-dwapi3) then
4759 fac=1.0D0/(1.0D0-cosphi)
4760 etorsi=v1(1,3,3)*fac
4761 etorsi=etorsi+etorsi
4762 etors=etors+etorsi-v1(1,3,3)
4763 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
4764 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4767 v1ij=v1(j+1,itori,itori1)
4768 v2ij=v2(j+1,itori,itori1)
4771 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4772 if (energy_dec) etors_ii=etors_ii+
4773 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4774 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4778 v1ij=v1(j,itori,itori1)
4779 v2ij=v2(j,itori,itori1)
4782 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4783 if (energy_dec) etors_ii=etors_ii+
4784 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4785 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4788 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4791 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4792 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4793 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4794 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
4795 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4797 ! 6/20/98 - dihedral angle constraints
4800 itori=idih_constr(i)
4803 if (difi.gt.drange(i)) then
4805 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4806 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4807 else if (difi.lt.-drange(i)) then
4809 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4810 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4812 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4813 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4815 ! write (iout,*) 'edihcnstr',edihcnstr
4818 c------------------------------------------------------------------------------
4819 subroutine etor_d(etors_d)
4823 c----------------------------------------------------------------------------
4825 subroutine etor(etors,edihcnstr)
4826 implicit real*8 (a-h,o-z)
4827 include 'DIMENSIONS'
4828 include 'COMMON.VAR'
4829 include 'COMMON.GEO'
4830 include 'COMMON.LOCAL'
4831 include 'COMMON.TORSION'
4832 include 'COMMON.INTERACT'
4833 include 'COMMON.DERIV'
4834 include 'COMMON.CHAIN'
4835 include 'COMMON.NAMES'
4836 include 'COMMON.IOUNITS'
4837 include 'COMMON.FFIELD'
4838 include 'COMMON.TORCNSTR'
4839 include 'COMMON.CONTROL'
4841 C Set lprn=.true. for debugging
4845 do i=iphi_start,iphi_end
4847 itori=itortyp(itype(i-2))
4848 itori1=itortyp(itype(i-1))
4851 C Regular cosine and sine terms
4852 do j=1,nterm(itori,itori1)
4853 v1ij=v1(j,itori,itori1)
4854 v2ij=v2(j,itori,itori1)
4857 etors=etors+v1ij*cosphi+v2ij*sinphi
4858 if (energy_dec) etors_ii=etors_ii+
4859 & v1ij*cosphi+v2ij*sinphi
4860 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4864 C E = SUM ----------------------------------- - v1
4865 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4867 cosphi=dcos(0.5d0*phii)
4868 sinphi=dsin(0.5d0*phii)
4869 do j=1,nlor(itori,itori1)
4870 vl1ij=vlor1(j,itori,itori1)
4871 vl2ij=vlor2(j,itori,itori1)
4872 vl3ij=vlor3(j,itori,itori1)
4873 pom=vl2ij*cosphi+vl3ij*sinphi
4874 pom1=1.0d0/(pom*pom+1.0d0)
4875 etors=etors+vl1ij*pom1
4876 if (energy_dec) etors_ii=etors_ii+
4879 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4881 C Subtract the constant term
4882 etors=etors-v0(itori,itori1)
4883 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4884 & 'etor',i,etors_ii-v0(itori,itori1)
4886 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4887 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4888 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4889 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
4890 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4892 ! 6/20/98 - dihedral angle constraints
4894 c do i=1,ndih_constr
4895 do i=idihconstr_start,idihconstr_end
4896 itori=idih_constr(i)
4898 difi=pinorm(phii-phi0(i))
4899 if (difi.gt.drange(i)) then
4901 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4902 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4903 else if (difi.lt.-drange(i)) then
4905 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4906 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4910 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4911 cd & rad2deg*phi0(i), rad2deg*drange(i),
4912 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4914 cd write (iout,*) 'edihcnstr',edihcnstr
4917 c----------------------------------------------------------------------------
4918 subroutine etor_d(etors_d)
4919 C 6/23/01 Compute double torsional energy
4920 implicit real*8 (a-h,o-z)
4921 include 'DIMENSIONS'
4922 include 'COMMON.VAR'
4923 include 'COMMON.GEO'
4924 include 'COMMON.LOCAL'
4925 include 'COMMON.TORSION'
4926 include 'COMMON.INTERACT'
4927 include 'COMMON.DERIV'
4928 include 'COMMON.CHAIN'
4929 include 'COMMON.NAMES'
4930 include 'COMMON.IOUNITS'
4931 include 'COMMON.FFIELD'
4932 include 'COMMON.TORCNSTR'
4934 C Set lprn=.true. for debugging
4938 do i=iphid_start,iphid_end
4939 itori=itortyp(itype(i-2))
4940 itori1=itortyp(itype(i-1))
4941 itori2=itortyp(itype(i))
4946 C Regular cosine and sine terms
4947 do j=1,ntermd_1(itori,itori1,itori2)
4948 v1cij=v1c(1,j,itori,itori1,itori2)
4949 v1sij=v1s(1,j,itori,itori1,itori2)
4950 v2cij=v1c(2,j,itori,itori1,itori2)
4951 v2sij=v1s(2,j,itori,itori1,itori2)
4952 cosphi1=dcos(j*phii)
4953 sinphi1=dsin(j*phii)
4954 cosphi2=dcos(j*phii1)
4955 sinphi2=dsin(j*phii1)
4956 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4957 & v2cij*cosphi2+v2sij*sinphi2
4958 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4959 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4961 do k=2,ntermd_2(itori,itori1,itori2)
4963 v1cdij = v2c(k,l,itori,itori1,itori2)
4964 v2cdij = v2c(l,k,itori,itori1,itori2)
4965 v1sdij = v2s(k,l,itori,itori1,itori2)
4966 v2sdij = v2s(l,k,itori,itori1,itori2)
4967 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4968 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4969 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4970 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4971 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4972 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4973 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4974 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4975 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4976 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4979 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
4980 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
4985 c------------------------------------------------------------------------------
4986 subroutine eback_sc_corr(esccor)
4987 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4988 c conformational states; temporarily implemented as differences
4989 c between UNRES torsional potentials (dependent on three types of
4990 c residues) and the torsional potentials dependent on all 20 types
4991 c of residues computed from AM1 energy surfaces of terminally-blocked
4992 c amino-acid residues.
4993 implicit real*8 (a-h,o-z)
4994 include 'DIMENSIONS'
4995 include 'COMMON.VAR'
4996 include 'COMMON.GEO'
4997 include 'COMMON.LOCAL'
4998 include 'COMMON.TORSION'
4999 include 'COMMON.SCCOR'
5000 include 'COMMON.INTERACT'
5001 include 'COMMON.DERIV'
5002 include 'COMMON.CHAIN'
5003 include 'COMMON.NAMES'
5004 include 'COMMON.IOUNITS'
5005 include 'COMMON.FFIELD'
5006 include 'COMMON.CONTROL'
5008 C Set lprn=.true. for debugging
5011 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5013 do i=iphi_start,iphi_end
5020 v1ij=v1sccor(j,itori,itori1)
5021 v2ij=v2sccor(j,itori,itori1)
5024 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5025 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5028 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5029 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5030 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5031 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5035 c----------------------------------------------------------------------------
5036 subroutine multibody(ecorr)
5037 C This subroutine calculates multi-body contributions to energy following
5038 C the idea of Skolnick et al. If side chains I and J make a contact and
5039 C at the same time side chains I+1 and J+1 make a contact, an extra
5040 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5041 implicit real*8 (a-h,o-z)
5042 include 'DIMENSIONS'
5043 include 'COMMON.IOUNITS'
5044 include 'COMMON.DERIV'
5045 include 'COMMON.INTERACT'
5046 include 'COMMON.CONTACTS'
5047 double precision gx(3),gx1(3)
5050 C Set lprn=.true. for debugging
5054 write (iout,'(a)') 'Contact function values:'
5056 write (iout,'(i2,20(1x,i2,f10.5))')
5057 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5072 num_conti=num_cont(i)
5073 num_conti1=num_cont(i1)
5078 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5079 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5080 cd & ' ishift=',ishift
5081 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5082 C The system gains extra energy.
5083 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5084 endif ! j1==j+-ishift
5093 c------------------------------------------------------------------------------
5094 double precision function esccorr(i,j,k,l,jj,kk)
5095 implicit real*8 (a-h,o-z)
5096 include 'DIMENSIONS'
5097 include 'COMMON.IOUNITS'
5098 include 'COMMON.DERIV'
5099 include 'COMMON.INTERACT'
5100 include 'COMMON.CONTACTS'
5101 double precision gx(3),gx1(3)
5106 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5107 C Calculate the multi-body contribution to energy.
5108 C Calculate multi-body contributions to the gradient.
5109 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5110 cd & k,l,(gacont(m,kk,k),m=1,3)
5112 gx(m) =ekl*gacont(m,jj,i)
5113 gx1(m)=eij*gacont(m,kk,k)
5114 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5115 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5116 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5117 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5121 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5126 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5132 c------------------------------------------------------------------------------
5134 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5135 implicit real*8 (a-h,o-z)
5136 include 'DIMENSIONS'
5137 integer dimen1,dimen2,atom,indx
5138 double precision buffer(dimen1,dimen2)
5139 double precision zapas
5140 common /contacts_hb/ zapas(3,maxconts,maxres,8),
5141 & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5142 & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5143 & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5144 num_kont=num_cont_hb(atom)
5148 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5151 buffer(i,indx+25)=facont_hb(i,atom)
5152 buffer(i,indx+26)=ees0p(i,atom)
5153 buffer(i,indx+27)=ees0m(i,atom)
5154 buffer(i,indx+28)=d_cont(i,atom)
5155 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
5157 buffer(1,indx+30)=dfloat(num_kont)
5160 c------------------------------------------------------------------------------
5161 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5162 implicit real*8 (a-h,o-z)
5163 include 'DIMENSIONS'
5164 integer dimen1,dimen2,atom,indx
5165 double precision buffer(dimen1,dimen2)
5166 double precision zapas
5167 common /contacts_hb/ zapas(3,maxconts,maxres,8),
5168 & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5169 & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5170 & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5171 num_kont=buffer(1,indx+30)
5172 num_kont_old=num_cont_hb(atom)
5173 num_cont_hb(atom)=num_kont+num_kont_old
5178 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5181 facont_hb(ii,atom)=buffer(i,indx+25)
5182 ees0p(ii,atom)=buffer(i,indx+26)
5183 ees0m(ii,atom)=buffer(i,indx+27)
5184 d_cont(i,atom)=buffer(i,indx+28)
5185 jcont_hb(ii,atom)=buffer(i,indx+29)
5189 c------------------------------------------------------------------------------
5191 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5192 C This subroutine calculates multi-body contributions to hydrogen-bonding
5193 implicit real*8 (a-h,o-z)
5194 include 'DIMENSIONS'
5195 include 'COMMON.IOUNITS'
5198 parameter (max_cont=maxconts)
5199 parameter (max_dim=2*(8*3+6))
5200 parameter (msglen1=max_cont*max_dim)
5201 parameter (msglen2=2*msglen1)
5202 integer source,CorrelType,CorrelID,Error
5203 double precision buffer(max_cont,max_dim)
5204 integer status(MPI_STATUS_SIZE)
5206 include 'COMMON.SETUP'
5207 include 'COMMON.FFIELD'
5208 include 'COMMON.DERIV'
5209 include 'COMMON.INTERACT'
5210 include 'COMMON.CONTACTS'
5211 include 'COMMON.CONTROL'
5212 double precision gx(3),gx1(3),time00
5215 C Set lprn=.true. for debugging
5220 if (nfgtasks.le.1) goto 30
5222 write (iout,'(a)') 'Contact function values:'
5224 write (iout,'(2i3,50(1x,i2,f5.2))')
5225 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5226 & j=1,num_cont_hb(i))
5229 C Caution! Following code assumes that electrostatic interactions concerning
5230 C a given atom are split among at most two processors!
5240 c write (*,*) 'MyRank',MyRank,' mm',mm
5243 c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5244 if (fg_rank.gt.0) then
5245 C Send correlation contributions to the preceding processor
5247 nn=num_cont_hb(iatel_s)
5248 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5249 c write (*,*) 'The BUFFER array:'
5251 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5253 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5255 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5256 C Clear the contacts of the atom passed to the neighboring processor
5257 nn=num_cont_hb(iatel_s+1)
5259 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5261 num_cont_hb(iatel_s)=0
5263 cd write (iout,*) 'Processor ',fg_rank,MyRank,
5264 cd & ' is sending correlation contribution to processor',fg_rank-1,
5265 cd & ' msglen=',msglen
5266 c write (*,*) 'Processor ',fg_rank,MyRank,
5267 c & ' is sending correlation contribution to processor',fg_rank-1,
5268 c & ' msglen=',msglen,' CorrelType=',CorrelType
5270 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5271 & CorrelType,FG_COMM,IERROR)
5272 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5273 cd write (iout,*) 'Processor ',fg_rank,
5274 cd & ' has sent correlation contribution to processor',fg_rank-1,
5275 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5276 c write (*,*) 'Processor ',fg_rank,
5277 c & ' has sent correlation contribution to processor',fg_rank-1,
5278 c & ' msglen=',msglen,' CorrelID=',CorrelID
5280 endif ! (fg_rank.gt.0)
5284 c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5285 if (fg_rank.lt.nfgtasks-1) then
5286 C Receive correlation contributions from the next processor
5288 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5289 cd write (iout,*) 'Processor',fg_rank,
5290 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5291 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5292 c write (*,*) 'Processor',fg_rank,
5293 c &' is receiving correlation contribution from processor',fg_rank+1,
5294 c & ' msglen=',msglen,' CorrelType=',CorrelType
5297 do while (nbytes.le.0)
5298 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5299 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5301 c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
5302 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5303 & fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5304 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5305 c write (*,*) 'Processor',fg_rank,
5306 c &' has received correlation contribution from processor',fg_rank+1,
5307 c & ' msglen=',msglen,' nbytes=',nbytes
5308 c write (*,*) 'The received BUFFER array:'
5310 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
5312 if (msglen.eq.msglen1) then
5313 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5314 else if (msglen.eq.msglen2) then
5315 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5316 call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5319 & 'ERROR!!!! message length changed while processing correlations.'
5321 & 'ERROR!!!! message length changed while processing correlations.'
5322 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5323 endif ! msglen.eq.msglen1
5324 endif ! fg_rank.lt.nfgtasks-1
5331 write (iout,'(a)') 'Contact function values:'
5333 write (iout,'(2i3,50(1x,i2,f5.2))')
5334 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5335 & j=1,num_cont_hb(i))
5339 C Remove the loop below after debugging !!!
5346 C Calculate the local-electrostatic correlation terms
5347 do i=iatel_s,iatel_e+1
5349 num_conti=num_cont_hb(i)
5350 num_conti1=num_cont_hb(i+1)
5355 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5356 c & ' jj=',jj,' kk=',kk
5357 if (j1.eq.j+1 .or. j1.eq.j-1) then
5358 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5359 C The system gains extra energy.
5360 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5361 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5362 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5364 else if (j1.eq.j) then
5365 C Contacts I-J and I-(J+1) occur simultaneously.
5366 C The system loses extra energy.
5367 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5372 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5373 c & ' jj=',jj,' kk=',kk
5375 C Contacts I-J and (I+1)-J occur simultaneously.
5376 C The system loses extra energy.
5377 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5384 c------------------------------------------------------------------------------
5385 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5387 C This subroutine calculates multi-body contributions to hydrogen-bonding
5388 implicit real*8 (a-h,o-z)
5389 include 'DIMENSIONS'
5390 include 'COMMON.IOUNITS'
5393 parameter (max_cont=maxconts)
5394 parameter (max_dim=2*(8*3+6))
5395 c parameter (msglen1=max_cont*max_dim*4)
5396 parameter (msglen1=max_cont*max_dim/2)
5397 parameter (msglen2=2*msglen1)
5398 integer source,CorrelType,CorrelID,Error
5399 double precision buffer(max_cont,max_dim)
5400 integer status(MPI_STATUS_SIZE)
5402 include 'COMMON.SETUP'
5403 include 'COMMON.FFIELD'
5404 include 'COMMON.DERIV'
5405 include 'COMMON.INTERACT'
5406 include 'COMMON.CONTACTS'
5407 include 'COMMON.CONTROL'
5408 double precision gx(3),gx1(3)
5410 C Set lprn=.true. for debugging
5416 if (fgProcs.le.1) goto 30
5418 write (iout,'(a)') 'Contact function values:'
5420 write (iout,'(2i3,50(1x,i2,f5.2))')
5421 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5422 & j=1,num_cont_hb(i))
5425 C Caution! Following code assumes that electrostatic interactions concerning
5426 C a given atom are split among at most two processors!
5436 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5439 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5440 if (MyRank.gt.0) then
5441 C Send correlation contributions to the preceding processor
5443 nn=num_cont_hb(iatel_s)
5444 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5445 cd write (iout,*) 'The BUFFER array:'
5447 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5449 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5451 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5452 C Clear the contacts of the atom passed to the neighboring processor
5453 nn=num_cont_hb(iatel_s+1)
5455 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5457 num_cont_hb(iatel_s)=0
5459 cd write (*,*) 'Processor ',fg_rank,MyRank,
5460 cd & ' is sending correlation contribution to processor',fg_rank-1,
5461 cd & ' msglen=',msglen
5462 cd write (*,*) 'Processor ',MyID,MyRank,
5463 cd & ' is sending correlation contribution to processor',fg_rank-1,
5464 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5466 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5467 & CorrelType,FG_COMM,IERROR)
5468 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5469 cd write (*,*) 'Processor ',fg_rank,MyRank,
5470 cd & ' has sent correlation contribution to processor',fg_rank-1,
5471 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5472 cd write (*,*) 'Processor ',fg_rank,
5473 cd & ' has sent correlation contribution to processor',fg_rank-1,
5474 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5476 endif ! (MyRank.gt.0)
5480 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5481 if (fg_rank.lt.nfgtasks-1) then
5482 C Receive correlation contributions from the next processor
5484 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5485 cd write (iout,*) 'Processor',fg_rank,
5486 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5487 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5488 cd write (*,*) 'Processor',fg_rank,
5489 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5490 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5493 do while (nbytes.le.0)
5494 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5495 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5497 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5498 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5499 & fg_rank+1,CorrelType,status,IERROR)
5500 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5501 cd write (iout,*) 'Processor',fg_rank,
5502 cd & ' has received correlation contribution from processor',fg_rank+1,
5503 cd & ' msglen=',msglen,' nbytes=',nbytes
5504 cd write (iout,*) 'The received BUFFER array:'
5506 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5508 if (msglen.eq.msglen1) then
5509 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5510 else if (msglen.eq.msglen2) then
5511 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5512 call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5515 & 'ERROR!!!! message length changed while processing correlations.'
5517 & 'ERROR!!!! message length changed while processing correlations.'
5518 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5519 endif ! msglen.eq.msglen1
5520 endif ! fg_rank.lt.nfgtasks-1
5527 write (iout,'(a)') 'Contact function values:'
5529 write (iout,'(2i3,50(1x,i2,f5.2))')
5530 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5531 & j=1,num_cont_hb(i))
5537 C Remove the loop below after debugging !!!
5544 C Calculate the dipole-dipole interaction energies
5545 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5546 do i=iatel_s,iatel_e+1
5547 num_conti=num_cont_hb(i)
5556 C Calculate the local-electrostatic correlation terms
5557 do i=iatel_s,iatel_e+1
5559 num_conti=num_cont_hb(i)
5560 num_conti1=num_cont_hb(i+1)
5565 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5566 c & ' jj=',jj,' kk=',kk
5567 if (j1.eq.j+1 .or. j1.eq.j-1) then
5568 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5569 C The system gains extra energy.
5571 sqd1=dsqrt(d_cont(jj,i))
5572 sqd2=dsqrt(d_cont(kk,i1))
5573 sred_geom = sqd1*sqd2
5574 IF (sred_geom.lt.cutoff_corr) THEN
5575 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5577 cd write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5578 cd & ' jj=',jj,' kk=',kk
5579 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5580 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5582 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5583 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5586 cd write (iout,*) 'sred_geom=',sred_geom,
5587 cd & ' ekont=',ekont,' fprim=',fprimcont
5588 call calc_eello(i,j,i+1,j1,jj,kk)
5589 if (wcorr4.gt.0.0d0)
5590 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5591 if (energy_dec.and.wcorr4.gt.0.0d0)
5592 1 write (iout,'(a6,2i5,0pf7.3)')
5593 2 'ecorr4',i,j,eello4(i,j,i+1,j1,jj,kk)
5594 if (wcorr5.gt.0.0d0)
5595 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5596 if (energy_dec.and.wcorr5.gt.0.0d0)
5597 1 write (iout,'(a6,2i5,0pf7.3)')
5598 2 'ecorr5',i,j,eello5(i,j,i+1,j1,jj,kk)
5599 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5600 cd write(2,*)'ijkl',i,j,i+1,j1
5601 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5602 & .or. wturn6.eq.0.0d0))then
5603 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5604 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5605 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5606 1 'ecorr6',i,j,eello6(i,j,i+1,j1,jj,kk)
5607 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5608 cd & 'ecorr6=',ecorr6
5609 cd write (iout,'(4e15.5)') sred_geom,
5610 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5611 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5612 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5613 else if (wturn6.gt.0.0d0
5614 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5615 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5616 eturn6=eturn6+eello_turn6(i,jj,kk)
5617 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5618 1 'eturn6',i,j,eello_turn6(i,jj,kk)
5619 cd write (2,*) 'multibody_eello:eturn6',eturn6
5623 else if (j1.eq.j) then
5624 C Contacts I-J and I-(J+1) occur simultaneously.
5625 C The system loses extra energy.
5626 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5631 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5632 c & ' jj=',jj,' kk=',kk
5634 C Contacts I-J and (I+1)-J occur simultaneously.
5635 C The system loses extra energy.
5636 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5643 c------------------------------------------------------------------------------
5644 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5645 implicit real*8 (a-h,o-z)
5646 include 'DIMENSIONS'
5647 include 'COMMON.IOUNITS'
5648 include 'COMMON.DERIV'
5649 include 'COMMON.INTERACT'
5650 include 'COMMON.CONTACTS'
5651 double precision gx(3),gx1(3)
5661 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5662 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5663 C Following 4 lines for diagnostics.
5668 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5670 c write (iout,*)'Contacts have occurred for peptide groups',
5671 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5672 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5673 C Calculate the multi-body contribution to energy.
5674 ecorr=ecorr+ekont*ees
5675 C Calculate multi-body contributions to the gradient.
5677 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5678 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5679 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5680 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5681 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5682 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5683 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5684 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5685 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5686 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5687 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5688 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5689 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5690 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5694 gradcorr(ll,m)=gradcorr(ll,m)+
5695 & ees*ekl*gacont_hbr(ll,jj,i)-
5696 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5697 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5702 gradcorr(ll,m)=gradcorr(ll,m)+
5703 & ees*eij*gacont_hbr(ll,kk,k)-
5704 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5705 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5712 C---------------------------------------------------------------------------
5713 subroutine dipole(i,j,jj)
5714 implicit real*8 (a-h,o-z)
5715 include 'DIMENSIONS'
5716 include 'COMMON.IOUNITS'
5717 include 'COMMON.CHAIN'
5718 include 'COMMON.FFIELD'
5719 include 'COMMON.DERIV'
5720 include 'COMMON.INTERACT'
5721 include 'COMMON.CONTACTS'
5722 include 'COMMON.TORSION'
5723 include 'COMMON.VAR'
5724 include 'COMMON.GEO'
5725 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5727 iti1 = itortyp(itype(i+1))
5728 if (j.lt.nres-1) then
5729 itj1 = itortyp(itype(j+1))
5734 dipi(iii,1)=Ub2(iii,i)
5735 dipderi(iii)=Ub2der(iii,i)
5736 dipi(iii,2)=b1(iii,iti1)
5737 dipj(iii,1)=Ub2(iii,j)
5738 dipderj(iii)=Ub2der(iii,j)
5739 dipj(iii,2)=b1(iii,itj1)
5743 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5746 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5753 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5757 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5762 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5763 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5765 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5767 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5769 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5774 C---------------------------------------------------------------------------
5775 subroutine calc_eello(i,j,k,l,jj,kk)
5777 C This subroutine computes matrices and vectors needed to calculate
5778 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5780 implicit real*8 (a-h,o-z)
5781 include 'DIMENSIONS'
5782 include 'COMMON.IOUNITS'
5783 include 'COMMON.CHAIN'
5784 include 'COMMON.DERIV'
5785 include 'COMMON.INTERACT'
5786 include 'COMMON.CONTACTS'
5787 include 'COMMON.TORSION'
5788 include 'COMMON.VAR'
5789 include 'COMMON.GEO'
5790 include 'COMMON.FFIELD'
5791 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5792 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5795 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5796 cd & ' jj=',jj,' kk=',kk
5797 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5800 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5801 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5804 call transpose2(aa1(1,1),aa1t(1,1))
5805 call transpose2(aa2(1,1),aa2t(1,1))
5808 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5809 & aa1tder(1,1,lll,kkk))
5810 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5811 & aa2tder(1,1,lll,kkk))
5815 C parallel orientation of the two CA-CA-CA frames.
5817 iti=itortyp(itype(i))
5821 itk1=itortyp(itype(k+1))
5822 itj=itortyp(itype(j))
5823 if (l.lt.nres-1) then
5824 itl1=itortyp(itype(l+1))
5828 C A1 kernel(j+1) A2T
5830 cd write (iout,'(3f10.5,5x,3f10.5)')
5831 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5833 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5834 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5835 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5836 C Following matrices are needed only for 6-th order cumulants
5837 IF (wcorr6.gt.0.0d0) THEN
5838 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5839 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5840 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5841 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5842 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5843 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5844 & ADtEAderx(1,1,1,1,1,1))
5846 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5847 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5848 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5849 & ADtEA1derx(1,1,1,1,1,1))
5851 C End 6-th order cumulants
5854 cd write (2,*) 'In calc_eello6'
5856 cd write (2,*) 'iii=',iii
5858 cd write (2,*) 'kkk=',kkk
5860 cd write (2,'(3(2f10.5),5x)')
5861 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5866 call transpose2(EUgder(1,1,k),auxmat(1,1))
5867 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5868 call transpose2(EUg(1,1,k),auxmat(1,1))
5869 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5870 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5874 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5875 & EAEAderx(1,1,lll,kkk,iii,1))
5879 C A1T kernel(i+1) A2
5880 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5881 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5882 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5883 C Following matrices are needed only for 6-th order cumulants
5884 IF (wcorr6.gt.0.0d0) THEN
5885 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5886 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5887 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5888 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5889 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5890 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5891 & ADtEAderx(1,1,1,1,1,2))
5892 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5893 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5894 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5895 & ADtEA1derx(1,1,1,1,1,2))
5897 C End 6-th order cumulants
5898 call transpose2(EUgder(1,1,l),auxmat(1,1))
5899 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5900 call transpose2(EUg(1,1,l),auxmat(1,1))
5901 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5902 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5906 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5907 & EAEAderx(1,1,lll,kkk,iii,2))
5912 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5913 C They are needed only when the fifth- or the sixth-order cumulants are
5915 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5916 call transpose2(AEA(1,1,1),auxmat(1,1))
5917 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5918 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5919 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5920 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5921 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5922 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5923 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5924 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5925 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5926 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5927 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5928 call transpose2(AEA(1,1,2),auxmat(1,1))
5929 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5930 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5931 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5932 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5933 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5934 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5935 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5936 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5937 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5938 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5939 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5940 C Calculate the Cartesian derivatives of the vectors.
5944 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5945 call matvec2(auxmat(1,1),b1(1,iti),
5946 & AEAb1derx(1,lll,kkk,iii,1,1))
5947 call matvec2(auxmat(1,1),Ub2(1,i),
5948 & AEAb2derx(1,lll,kkk,iii,1,1))
5949 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5950 & AEAb1derx(1,lll,kkk,iii,2,1))
5951 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5952 & AEAb2derx(1,lll,kkk,iii,2,1))
5953 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5954 call matvec2(auxmat(1,1),b1(1,itj),
5955 & AEAb1derx(1,lll,kkk,iii,1,2))
5956 call matvec2(auxmat(1,1),Ub2(1,j),
5957 & AEAb2derx(1,lll,kkk,iii,1,2))
5958 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5959 & AEAb1derx(1,lll,kkk,iii,2,2))
5960 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5961 & AEAb2derx(1,lll,kkk,iii,2,2))
5968 C Antiparallel orientation of the two CA-CA-CA frames.
5970 iti=itortyp(itype(i))
5974 itk1=itortyp(itype(k+1))
5975 itl=itortyp(itype(l))
5976 itj=itortyp(itype(j))
5977 if (j.lt.nres-1) then
5978 itj1=itortyp(itype(j+1))
5982 C A2 kernel(j-1)T A1T
5983 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5984 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5985 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5986 C Following matrices are needed only for 6-th order cumulants
5987 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5988 & j.eq.i+4 .and. l.eq.i+3)) THEN
5989 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5990 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5991 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5992 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5993 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5994 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5995 & ADtEAderx(1,1,1,1,1,1))
5996 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5997 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5998 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5999 & ADtEA1derx(1,1,1,1,1,1))
6001 C End 6-th order cumulants
6002 call transpose2(EUgder(1,1,k),auxmat(1,1))
6003 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6004 call transpose2(EUg(1,1,k),auxmat(1,1))
6005 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6006 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6010 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6011 & EAEAderx(1,1,lll,kkk,iii,1))
6015 C A2T kernel(i+1)T A1
6016 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6017 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6018 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6019 C Following matrices are needed only for 6-th order cumulants
6020 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6021 & j.eq.i+4 .and. l.eq.i+3)) THEN
6022 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6023 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6024 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6025 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6026 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6027 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6028 & ADtEAderx(1,1,1,1,1,2))
6029 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6030 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6031 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6032 & ADtEA1derx(1,1,1,1,1,2))
6034 C End 6-th order cumulants
6035 call transpose2(EUgder(1,1,j),auxmat(1,1))
6036 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6037 call transpose2(EUg(1,1,j),auxmat(1,1))
6038 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6039 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6043 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6044 & EAEAderx(1,1,lll,kkk,iii,2))
6049 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6050 C They are needed only when the fifth- or the sixth-order cumulants are
6052 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6053 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6054 call transpose2(AEA(1,1,1),auxmat(1,1))
6055 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6056 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6057 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6058 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6059 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6060 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6061 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6062 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6063 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6064 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6065 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6066 call transpose2(AEA(1,1,2),auxmat(1,1))
6067 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6068 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6069 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6070 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6071 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6072 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6073 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6074 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6075 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6076 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6077 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6078 C Calculate the Cartesian derivatives of the vectors.
6082 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6083 call matvec2(auxmat(1,1),b1(1,iti),
6084 & AEAb1derx(1,lll,kkk,iii,1,1))
6085 call matvec2(auxmat(1,1),Ub2(1,i),
6086 & AEAb2derx(1,lll,kkk,iii,1,1))
6087 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6088 & AEAb1derx(1,lll,kkk,iii,2,1))
6089 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6090 & AEAb2derx(1,lll,kkk,iii,2,1))
6091 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6092 call matvec2(auxmat(1,1),b1(1,itl),
6093 & AEAb1derx(1,lll,kkk,iii,1,2))
6094 call matvec2(auxmat(1,1),Ub2(1,l),
6095 & AEAb2derx(1,lll,kkk,iii,1,2))
6096 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6097 & AEAb1derx(1,lll,kkk,iii,2,2))
6098 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6099 & AEAb2derx(1,lll,kkk,iii,2,2))
6108 C---------------------------------------------------------------------------
6109 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6110 & KK,KKderg,AKA,AKAderg,AKAderx)
6114 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6115 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6116 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6121 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6123 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6126 cd if (lprn) write (2,*) 'In kernel'
6128 cd if (lprn) write (2,*) 'kkk=',kkk
6130 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6131 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6133 cd write (2,*) 'lll=',lll
6134 cd write (2,*) 'iii=1'
6136 cd write (2,'(3(2f10.5),5x)')
6137 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6140 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6141 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6143 cd write (2,*) 'lll=',lll
6144 cd write (2,*) 'iii=2'
6146 cd write (2,'(3(2f10.5),5x)')
6147 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6154 C---------------------------------------------------------------------------
6155 double precision function eello4(i,j,k,l,jj,kk)
6156 implicit real*8 (a-h,o-z)
6157 include 'DIMENSIONS'
6158 include 'COMMON.IOUNITS'
6159 include 'COMMON.CHAIN'
6160 include 'COMMON.DERIV'
6161 include 'COMMON.INTERACT'
6162 include 'COMMON.CONTACTS'
6163 include 'COMMON.TORSION'
6164 include 'COMMON.VAR'
6165 include 'COMMON.GEO'
6166 double precision pizda(2,2),ggg1(3),ggg2(3)
6167 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6171 cd print *,'eello4:',i,j,k,l,jj,kk
6172 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6173 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6174 cold eij=facont_hb(jj,i)
6175 cold ekl=facont_hb(kk,k)
6177 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6178 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6179 gcorr_loc(k-1)=gcorr_loc(k-1)
6180 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6182 gcorr_loc(l-1)=gcorr_loc(l-1)
6183 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6185 gcorr_loc(j-1)=gcorr_loc(j-1)
6186 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6191 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6192 & -EAEAderx(2,2,lll,kkk,iii,1)
6193 cd derx(lll,kkk,iii)=0.0d0
6197 cd gcorr_loc(l-1)=0.0d0
6198 cd gcorr_loc(j-1)=0.0d0
6199 cd gcorr_loc(k-1)=0.0d0
6201 cd write (iout,*)'Contacts have occurred for peptide groups',
6202 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6203 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6204 if (j.lt.nres-1) then
6211 if (l.lt.nres-1) then
6219 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6220 ggg1(ll)=eel4*g_contij(ll,1)
6221 ggg2(ll)=eel4*g_contij(ll,2)
6222 ghalf=0.5d0*ggg1(ll)
6224 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6225 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6226 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6227 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6228 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6229 ghalf=0.5d0*ggg2(ll)
6231 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6232 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6233 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6234 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6239 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6240 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6245 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6246 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6252 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6257 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6261 cd write (2,*) iii,gcorr_loc(iii)
6264 cd write (2,*) 'ekont',ekont
6265 cd write (iout,*) 'eello4',ekont*eel4
6268 C---------------------------------------------------------------------------
6269 double precision function eello5(i,j,k,l,jj,kk)
6270 implicit real*8 (a-h,o-z)
6271 include 'DIMENSIONS'
6272 include 'COMMON.IOUNITS'
6273 include 'COMMON.CHAIN'
6274 include 'COMMON.DERIV'
6275 include 'COMMON.INTERACT'
6276 include 'COMMON.CONTACTS'
6277 include 'COMMON.TORSION'
6278 include 'COMMON.VAR'
6279 include 'COMMON.GEO'
6280 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6281 double precision ggg1(3),ggg2(3)
6282 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6287 C /l\ / \ \ / \ / \ / C
6288 C / \ / \ \ / \ / \ / C
6289 C j| o |l1 | o | o| o | | o |o C
6290 C \ |/k\| |/ \| / |/ \| |/ \| C
6291 C \i/ \ / \ / / \ / \ C
6293 C (I) (II) (III) (IV) C
6295 C eello5_1 eello5_2 eello5_3 eello5_4 C
6297 C Antiparallel chains C
6300 C /j\ / \ \ / \ / \ / C
6301 C / \ / \ \ / \ / \ / C
6302 C j1| o |l | o | o| o | | o |o C
6303 C \ |/k\| |/ \| / |/ \| |/ \| C
6304 C \i/ \ / \ / / \ / \ C
6306 C (I) (II) (III) (IV) C
6308 C eello5_1 eello5_2 eello5_3 eello5_4 C
6310 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6312 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6313 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6318 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6320 itk=itortyp(itype(k))
6321 itl=itortyp(itype(l))
6322 itj=itortyp(itype(j))
6327 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6328 cd & eel5_3_num,eel5_4_num)
6332 derx(lll,kkk,iii)=0.0d0
6336 cd eij=facont_hb(jj,i)
6337 cd ekl=facont_hb(kk,k)
6339 cd write (iout,*)'Contacts have occurred for peptide groups',
6340 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6342 C Contribution from the graph I.
6343 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6344 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6345 call transpose2(EUg(1,1,k),auxmat(1,1))
6346 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6347 vv(1)=pizda(1,1)-pizda(2,2)
6348 vv(2)=pizda(1,2)+pizda(2,1)
6349 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6350 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6351 C Explicit gradient in virtual-dihedral angles.
6352 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6353 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6354 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6355 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6356 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6357 vv(1)=pizda(1,1)-pizda(2,2)
6358 vv(2)=pizda(1,2)+pizda(2,1)
6359 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6360 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6361 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6362 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6363 vv(1)=pizda(1,1)-pizda(2,2)
6364 vv(2)=pizda(1,2)+pizda(2,1)
6366 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6367 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6368 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6370 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6371 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6372 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6374 C Cartesian gradient
6378 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6380 vv(1)=pizda(1,1)-pizda(2,2)
6381 vv(2)=pizda(1,2)+pizda(2,1)
6382 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6383 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6384 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6390 C Contribution from graph II
6391 call transpose2(EE(1,1,itk),auxmat(1,1))
6392 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6393 vv(1)=pizda(1,1)+pizda(2,2)
6394 vv(2)=pizda(2,1)-pizda(1,2)
6395 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6396 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6397 C Explicit gradient in virtual-dihedral angles.
6398 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6399 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6400 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6401 vv(1)=pizda(1,1)+pizda(2,2)
6402 vv(2)=pizda(2,1)-pizda(1,2)
6404 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6405 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6406 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6408 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6409 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6410 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6412 C Cartesian gradient
6416 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6418 vv(1)=pizda(1,1)+pizda(2,2)
6419 vv(2)=pizda(2,1)-pizda(1,2)
6420 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6421 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6422 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6430 C Parallel orientation
6431 C Contribution from graph III
6432 call transpose2(EUg(1,1,l),auxmat(1,1))
6433 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6434 vv(1)=pizda(1,1)-pizda(2,2)
6435 vv(2)=pizda(1,2)+pizda(2,1)
6436 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6437 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6438 C Explicit gradient in virtual-dihedral angles.
6439 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6440 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6441 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6442 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6443 vv(1)=pizda(1,1)-pizda(2,2)
6444 vv(2)=pizda(1,2)+pizda(2,1)
6445 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6446 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6447 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6448 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6449 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6450 vv(1)=pizda(1,1)-pizda(2,2)
6451 vv(2)=pizda(1,2)+pizda(2,1)
6452 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6453 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6454 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6455 C Cartesian gradient
6459 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6461 vv(1)=pizda(1,1)-pizda(2,2)
6462 vv(2)=pizda(1,2)+pizda(2,1)
6463 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6464 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6465 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6470 C Contribution from graph IV
6472 call transpose2(EE(1,1,itl),auxmat(1,1))
6473 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6474 vv(1)=pizda(1,1)+pizda(2,2)
6475 vv(2)=pizda(2,1)-pizda(1,2)
6476 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6477 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6478 C Explicit gradient in virtual-dihedral angles.
6479 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6480 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6481 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6482 vv(1)=pizda(1,1)+pizda(2,2)
6483 vv(2)=pizda(2,1)-pizda(1,2)
6484 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6485 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6486 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6487 C Cartesian gradient
6491 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6493 vv(1)=pizda(1,1)+pizda(2,2)
6494 vv(2)=pizda(2,1)-pizda(1,2)
6495 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6496 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6497 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6502 C Antiparallel orientation
6503 C Contribution from graph III
6505 call transpose2(EUg(1,1,j),auxmat(1,1))
6506 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6507 vv(1)=pizda(1,1)-pizda(2,2)
6508 vv(2)=pizda(1,2)+pizda(2,1)
6509 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6510 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6511 C Explicit gradient in virtual-dihedral angles.
6512 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6513 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6514 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6515 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6516 vv(1)=pizda(1,1)-pizda(2,2)
6517 vv(2)=pizda(1,2)+pizda(2,1)
6518 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6519 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6520 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6521 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6522 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6523 vv(1)=pizda(1,1)-pizda(2,2)
6524 vv(2)=pizda(1,2)+pizda(2,1)
6525 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6526 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6527 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6528 C Cartesian gradient
6532 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6534 vv(1)=pizda(1,1)-pizda(2,2)
6535 vv(2)=pizda(1,2)+pizda(2,1)
6536 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6537 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6538 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6543 C Contribution from graph IV
6545 call transpose2(EE(1,1,itj),auxmat(1,1))
6546 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6547 vv(1)=pizda(1,1)+pizda(2,2)
6548 vv(2)=pizda(2,1)-pizda(1,2)
6549 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6550 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6551 C Explicit gradient in virtual-dihedral angles.
6552 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6553 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6554 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6555 vv(1)=pizda(1,1)+pizda(2,2)
6556 vv(2)=pizda(2,1)-pizda(1,2)
6557 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6558 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6559 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6560 C Cartesian gradient
6564 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6566 vv(1)=pizda(1,1)+pizda(2,2)
6567 vv(2)=pizda(2,1)-pizda(1,2)
6568 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6569 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6570 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6576 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6577 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6578 cd write (2,*) 'ijkl',i,j,k,l
6579 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6580 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6582 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6583 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6584 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6585 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6586 if (j.lt.nres-1) then
6593 if (l.lt.nres-1) then
6603 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6605 ggg1(ll)=eel5*g_contij(ll,1)
6606 ggg2(ll)=eel5*g_contij(ll,2)
6607 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6608 ghalf=0.5d0*ggg1(ll)
6610 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6611 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6612 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6613 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6614 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6615 ghalf=0.5d0*ggg2(ll)
6617 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6618 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6619 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6620 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6625 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6626 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6631 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6632 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6638 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6643 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6647 cd write (2,*) iii,g_corr5_loc(iii)
6650 cd write (2,*) 'ekont',ekont
6651 cd write (iout,*) 'eello5',ekont*eel5
6654 c--------------------------------------------------------------------------
6655 double precision function eello6(i,j,k,l,jj,kk)
6656 implicit real*8 (a-h,o-z)
6657 include 'DIMENSIONS'
6658 include 'COMMON.IOUNITS'
6659 include 'COMMON.CHAIN'
6660 include 'COMMON.DERIV'
6661 include 'COMMON.INTERACT'
6662 include 'COMMON.CONTACTS'
6663 include 'COMMON.TORSION'
6664 include 'COMMON.VAR'
6665 include 'COMMON.GEO'
6666 include 'COMMON.FFIELD'
6667 double precision ggg1(3),ggg2(3)
6668 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6673 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6681 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6682 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6686 derx(lll,kkk,iii)=0.0d0
6690 cd eij=facont_hb(jj,i)
6691 cd ekl=facont_hb(kk,k)
6697 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6698 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6699 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6700 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6701 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6702 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6704 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6705 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6706 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6707 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6708 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6709 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6713 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6715 C If turn contributions are considered, they will be handled separately.
6716 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6717 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6718 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6719 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6720 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6721 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6722 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6724 if (j.lt.nres-1) then
6731 if (l.lt.nres-1) then
6739 ggg1(ll)=eel6*g_contij(ll,1)
6740 ggg2(ll)=eel6*g_contij(ll,2)
6741 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6742 ghalf=0.5d0*ggg1(ll)
6744 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6745 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6746 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6747 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6748 ghalf=0.5d0*ggg2(ll)
6749 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6751 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6752 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6753 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6754 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6759 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6760 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6765 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6766 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6772 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6777 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6781 cd write (2,*) iii,g_corr6_loc(iii)
6784 cd write (2,*) 'ekont',ekont
6785 cd write (iout,*) 'eello6',ekont*eel6
6788 c--------------------------------------------------------------------------
6789 double precision function eello6_graph1(i,j,k,l,imat,swap)
6790 implicit real*8 (a-h,o-z)
6791 include 'DIMENSIONS'
6792 include 'COMMON.IOUNITS'
6793 include 'COMMON.CHAIN'
6794 include 'COMMON.DERIV'
6795 include 'COMMON.INTERACT'
6796 include 'COMMON.CONTACTS'
6797 include 'COMMON.TORSION'
6798 include 'COMMON.VAR'
6799 include 'COMMON.GEO'
6800 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6804 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6806 C Parallel Antiparallel
6812 C \ j|/k\| / \ |/k\|l /
6817 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6818 itk=itortyp(itype(k))
6819 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6820 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6821 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6822 call transpose2(EUgC(1,1,k),auxmat(1,1))
6823 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6824 vv1(1)=pizda1(1,1)-pizda1(2,2)
6825 vv1(2)=pizda1(1,2)+pizda1(2,1)
6826 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6827 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6828 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6829 s5=scalar2(vv(1),Dtobr2(1,i))
6830 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6831 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6832 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6833 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6834 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6835 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6836 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6837 & +scalar2(vv(1),Dtobr2der(1,i)))
6838 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6839 vv1(1)=pizda1(1,1)-pizda1(2,2)
6840 vv1(2)=pizda1(1,2)+pizda1(2,1)
6841 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6842 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6844 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6845 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6846 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6847 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6848 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6850 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6851 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6852 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6853 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6854 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6856 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6857 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6858 vv1(1)=pizda1(1,1)-pizda1(2,2)
6859 vv1(2)=pizda1(1,2)+pizda1(2,1)
6860 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6861 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6862 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6863 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6872 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6873 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6874 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6875 call transpose2(EUgC(1,1,k),auxmat(1,1))
6876 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6878 vv1(1)=pizda1(1,1)-pizda1(2,2)
6879 vv1(2)=pizda1(1,2)+pizda1(2,1)
6880 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6881 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6882 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6883 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6884 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6885 s5=scalar2(vv(1),Dtobr2(1,i))
6886 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6892 c----------------------------------------------------------------------------
6893 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6894 implicit real*8 (a-h,o-z)
6895 include 'DIMENSIONS'
6896 include 'COMMON.IOUNITS'
6897 include 'COMMON.CHAIN'
6898 include 'COMMON.DERIV'
6899 include 'COMMON.INTERACT'
6900 include 'COMMON.CONTACTS'
6901 include 'COMMON.TORSION'
6902 include 'COMMON.VAR'
6903 include 'COMMON.GEO'
6905 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6906 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6909 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6911 C Parallel Antiparallel
6922 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6923 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6924 C AL 7/4/01 s1 would occur in the sixth-order moment,
6925 C but not in a cluster cumulant
6927 s1=dip(1,jj,i)*dip(1,kk,k)
6929 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6930 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6931 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6932 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6933 call transpose2(EUg(1,1,k),auxmat(1,1))
6934 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6935 vv(1)=pizda(1,1)-pizda(2,2)
6936 vv(2)=pizda(1,2)+pizda(2,1)
6937 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6938 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6940 eello6_graph2=-(s1+s2+s3+s4)
6942 eello6_graph2=-(s2+s3+s4)
6945 C Derivatives in gamma(i-1)
6948 s1=dipderg(1,jj,i)*dip(1,kk,k)
6950 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6951 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6952 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6953 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6955 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6957 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6959 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6961 C Derivatives in gamma(k-1)
6963 s1=dip(1,jj,i)*dipderg(1,kk,k)
6965 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6966 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6967 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6968 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6969 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6970 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6971 vv(1)=pizda(1,1)-pizda(2,2)
6972 vv(2)=pizda(1,2)+pizda(2,1)
6973 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6975 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6977 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6979 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6980 C Derivatives in gamma(j-1) or gamma(l-1)
6983 s1=dipderg(3,jj,i)*dip(1,kk,k)
6985 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6986 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6987 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6988 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6989 vv(1)=pizda(1,1)-pizda(2,2)
6990 vv(2)=pizda(1,2)+pizda(2,1)
6991 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6994 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6996 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6999 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7000 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7002 C Derivatives in gamma(l-1) or gamma(j-1)
7005 s1=dip(1,jj,i)*dipderg(3,kk,k)
7007 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7008 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7009 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7010 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7011 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7012 vv(1)=pizda(1,1)-pizda(2,2)
7013 vv(2)=pizda(1,2)+pizda(2,1)
7014 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7017 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7019 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7022 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7023 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7025 C Cartesian derivatives.
7027 write (2,*) 'In eello6_graph2'
7029 write (2,*) 'iii=',iii
7031 write (2,*) 'kkk=',kkk
7033 write (2,'(3(2f10.5),5x)')
7034 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7044 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7046 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7049 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7051 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7052 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7054 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7055 call transpose2(EUg(1,1,k),auxmat(1,1))
7056 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7058 vv(1)=pizda(1,1)-pizda(2,2)
7059 vv(2)=pizda(1,2)+pizda(2,1)
7060 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7061 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7063 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7065 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7068 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7070 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7077 c----------------------------------------------------------------------------
7078 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7079 implicit real*8 (a-h,o-z)
7080 include 'DIMENSIONS'
7081 include 'COMMON.IOUNITS'
7082 include 'COMMON.CHAIN'
7083 include 'COMMON.DERIV'
7084 include 'COMMON.INTERACT'
7085 include 'COMMON.CONTACTS'
7086 include 'COMMON.TORSION'
7087 include 'COMMON.VAR'
7088 include 'COMMON.GEO'
7089 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7091 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7093 C Parallel Antiparallel
7104 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7106 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7107 C energy moment and not to the cluster cumulant.
7108 iti=itortyp(itype(i))
7109 if (j.lt.nres-1) then
7110 itj1=itortyp(itype(j+1))
7114 itk=itortyp(itype(k))
7115 itk1=itortyp(itype(k+1))
7116 if (l.lt.nres-1) then
7117 itl1=itortyp(itype(l+1))
7122 s1=dip(4,jj,i)*dip(4,kk,k)
7124 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7125 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7126 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7127 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7128 call transpose2(EE(1,1,itk),auxmat(1,1))
7129 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7130 vv(1)=pizda(1,1)+pizda(2,2)
7131 vv(2)=pizda(2,1)-pizda(1,2)
7132 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7133 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7135 eello6_graph3=-(s1+s2+s3+s4)
7137 eello6_graph3=-(s2+s3+s4)
7140 C Derivatives in gamma(k-1)
7141 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7142 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7143 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7144 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7145 C Derivatives in gamma(l-1)
7146 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7147 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7148 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7149 vv(1)=pizda(1,1)+pizda(2,2)
7150 vv(2)=pizda(2,1)-pizda(1,2)
7151 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7152 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7153 C Cartesian derivatives.
7159 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7161 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7164 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7166 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7167 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7169 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7170 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7172 vv(1)=pizda(1,1)+pizda(2,2)
7173 vv(2)=pizda(2,1)-pizda(1,2)
7174 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7176 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7178 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7181 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7183 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7185 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7191 c----------------------------------------------------------------------------
7192 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7193 implicit real*8 (a-h,o-z)
7194 include 'DIMENSIONS'
7195 include 'COMMON.IOUNITS'
7196 include 'COMMON.CHAIN'
7197 include 'COMMON.DERIV'
7198 include 'COMMON.INTERACT'
7199 include 'COMMON.CONTACTS'
7200 include 'COMMON.TORSION'
7201 include 'COMMON.VAR'
7202 include 'COMMON.GEO'
7203 include 'COMMON.FFIELD'
7204 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7205 & auxvec1(2),auxmat1(2,2)
7207 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7209 C Parallel Antiparallel
7220 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7222 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7223 C energy moment and not to the cluster cumulant.
7224 cd write (2,*) 'eello_graph4: wturn6',wturn6
7225 iti=itortyp(itype(i))
7226 itj=itortyp(itype(j))
7227 if (j.lt.nres-1) then
7228 itj1=itortyp(itype(j+1))
7232 itk=itortyp(itype(k))
7233 if (k.lt.nres-1) then
7234 itk1=itortyp(itype(k+1))
7238 itl=itortyp(itype(l))
7239 if (l.lt.nres-1) then
7240 itl1=itortyp(itype(l+1))
7244 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7245 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7246 cd & ' itl',itl,' itl1',itl1
7249 s1=dip(3,jj,i)*dip(3,kk,k)
7251 s1=dip(2,jj,j)*dip(2,kk,l)
7254 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7255 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7257 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7258 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7260 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7261 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7263 call transpose2(EUg(1,1,k),auxmat(1,1))
7264 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7265 vv(1)=pizda(1,1)-pizda(2,2)
7266 vv(2)=pizda(2,1)+pizda(1,2)
7267 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7268 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7270 eello6_graph4=-(s1+s2+s3+s4)
7272 eello6_graph4=-(s2+s3+s4)
7274 C Derivatives in gamma(i-1)
7278 s1=dipderg(2,jj,i)*dip(3,kk,k)
7280 s1=dipderg(4,jj,j)*dip(2,kk,l)
7283 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7285 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7286 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7288 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7289 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7291 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7292 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7293 cd write (2,*) 'turn6 derivatives'
7295 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7297 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7301 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7303 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7307 C Derivatives in gamma(k-1)
7310 s1=dip(3,jj,i)*dipderg(2,kk,k)
7312 s1=dip(2,jj,j)*dipderg(4,kk,l)
7315 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7316 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7318 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7319 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7321 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7322 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7324 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7325 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7326 vv(1)=pizda(1,1)-pizda(2,2)
7327 vv(2)=pizda(2,1)+pizda(1,2)
7328 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7329 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7331 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7333 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7337 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7339 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7342 C Derivatives in gamma(j-1) or gamma(l-1)
7343 if (l.eq.j+1 .and. l.gt.1) then
7344 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7345 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7346 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7347 vv(1)=pizda(1,1)-pizda(2,2)
7348 vv(2)=pizda(2,1)+pizda(1,2)
7349 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7350 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7351 else if (j.gt.1) then
7352 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7353 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7354 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7355 vv(1)=pizda(1,1)-pizda(2,2)
7356 vv(2)=pizda(2,1)+pizda(1,2)
7357 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7358 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7359 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7361 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7364 C Cartesian derivatives.
7371 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7373 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7377 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7379 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7383 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7385 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7387 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7388 & b1(1,itj1),auxvec(1))
7389 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7391 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7392 & b1(1,itl1),auxvec(1))
7393 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7395 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7397 vv(1)=pizda(1,1)-pizda(2,2)
7398 vv(2)=pizda(2,1)+pizda(1,2)
7399 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7401 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7403 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7406 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7409 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7412 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7414 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7416 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7420 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7422 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7425 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7427 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7435 c----------------------------------------------------------------------------
7436 double precision function eello_turn6(i,jj,kk)
7437 implicit real*8 (a-h,o-z)
7438 include 'DIMENSIONS'
7439 include 'COMMON.IOUNITS'
7440 include 'COMMON.CHAIN'
7441 include 'COMMON.DERIV'
7442 include 'COMMON.INTERACT'
7443 include 'COMMON.CONTACTS'
7444 include 'COMMON.TORSION'
7445 include 'COMMON.VAR'
7446 include 'COMMON.GEO'
7447 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7448 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7450 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7451 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7452 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7453 C the respective energy moment and not to the cluster cumulant.
7462 iti=itortyp(itype(i))
7463 itk=itortyp(itype(k))
7464 itk1=itortyp(itype(k+1))
7465 itl=itortyp(itype(l))
7466 itj=itortyp(itype(j))
7467 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7468 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7469 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7474 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7476 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7480 derx_turn(lll,kkk,iii)=0.0d0
7487 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7489 cd write (2,*) 'eello6_5',eello6_5
7491 call transpose2(AEA(1,1,1),auxmat(1,1))
7492 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7493 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7494 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7496 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7497 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7498 s2 = scalar2(b1(1,itk),vtemp1(1))
7500 call transpose2(AEA(1,1,2),atemp(1,1))
7501 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7502 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7503 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7505 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7506 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7507 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7509 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7510 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7511 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7512 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7513 ss13 = scalar2(b1(1,itk),vtemp4(1))
7514 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7516 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7522 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7523 C Derivatives in gamma(i+2)
7527 call transpose2(AEA(1,1,1),auxmatd(1,1))
7528 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7529 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7530 call transpose2(AEAderg(1,1,2),atempd(1,1))
7531 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7532 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7534 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7535 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7536 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7542 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7543 C Derivatives in gamma(i+3)
7545 call transpose2(AEA(1,1,1),auxmatd(1,1))
7546 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7547 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7548 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7550 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7551 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7552 s2d = scalar2(b1(1,itk),vtemp1d(1))
7554 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7555 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7557 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7559 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7560 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7561 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7569 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7570 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7572 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7573 & -0.5d0*ekont*(s2d+s12d)
7575 C Derivatives in gamma(i+4)
7576 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7577 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7578 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7580 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7581 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7582 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7590 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7592 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7594 C Derivatives in gamma(i+5)
7596 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7597 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7598 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7600 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7601 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7602 s2d = scalar2(b1(1,itk),vtemp1d(1))
7604 call transpose2(AEA(1,1,2),atempd(1,1))
7605 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7606 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7608 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7609 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7611 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7612 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7613 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7621 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7622 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7624 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7625 & -0.5d0*ekont*(s2d+s12d)
7627 C Cartesian derivatives
7632 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7633 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7634 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7636 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7637 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7639 s2d = scalar2(b1(1,itk),vtemp1d(1))
7641 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7642 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7643 s8d = -(atempd(1,1)+atempd(2,2))*
7644 & scalar2(cc(1,1,itl),vtemp2(1))
7646 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7648 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7649 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7656 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7659 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7663 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7664 & - 0.5d0*(s8d+s12d)
7666 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7675 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7677 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7678 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7679 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7680 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7681 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7683 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7684 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7685 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7689 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7690 cd & 16*eel_turn6_num
7692 if (j.lt.nres-1) then
7699 if (l.lt.nres-1) then
7707 ggg1(ll)=eel_turn6*g_contij(ll,1)
7708 ggg2(ll)=eel_turn6*g_contij(ll,2)
7709 ghalf=0.5d0*ggg1(ll)
7711 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7712 & +ekont*derx_turn(ll,2,1)
7713 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7714 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7715 & +ekont*derx_turn(ll,4,1)
7716 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7717 ghalf=0.5d0*ggg2(ll)
7719 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7720 & +ekont*derx_turn(ll,2,2)
7721 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7722 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7723 & +ekont*derx_turn(ll,4,2)
7724 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7729 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7734 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7740 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7745 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7749 cd write (2,*) iii,g_corr6_loc(iii)
7751 eello_turn6=ekont*eel_turn6
7752 cd write (2,*) 'ekont',ekont
7753 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7757 C-----------------------------------------------------------------------------
7758 double precision function scalar(u,v)
7759 !DIR$ INLINEALWAYS scalar
7761 cDEC$ ATTRIBUTES FORCEINLINE::scalar
7764 double precision u(3),v(3)
7765 cd double precision sc
7773 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
7776 crc-------------------------------------------------
7777 SUBROUTINE MATVEC2(A1,V1,V2)
7778 !DIR$ INLINEALWAYS MATVEC2
7780 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
7782 implicit real*8 (a-h,o-z)
7783 include 'DIMENSIONS'
7784 DIMENSION A1(2,2),V1(2),V2(2)
7788 c 3 VI=VI+A1(I,K)*V1(K)
7792 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7793 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7798 C---------------------------------------
7799 SUBROUTINE MATMAT2(A1,A2,A3)
7801 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
7803 implicit real*8 (a-h,o-z)
7804 include 'DIMENSIONS'
7805 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7806 c DIMENSION AI3(2,2)
7810 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7816 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7817 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7818 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7819 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7827 c-------------------------------------------------------------------------
7828 double precision function scalar2(u,v)
7829 !DIR$ INLINEALWAYS scalar2
7831 double precision u(2),v(2)
7834 scalar2=u(1)*v(1)+u(2)*v(2)
7838 C-----------------------------------------------------------------------------
7840 subroutine transpose2(a,at)
7841 !DIR$ INLINEALWAYS transpose2
7843 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
7846 double precision a(2,2),at(2,2)
7853 c--------------------------------------------------------------------------
7854 subroutine transpose(n,a,at)
7857 double precision a(n,n),at(n,n)
7865 C---------------------------------------------------------------------------
7866 subroutine prodmat3(a1,a2,kk,transp,prod)
7867 !DIR$ INLINEALWAYS prodmat3
7869 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
7873 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7875 crc double precision auxmat(2,2),prod_(2,2)
7878 crc call transpose2(kk(1,1),auxmat(1,1))
7879 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7880 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7882 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7883 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7884 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7885 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7886 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7887 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7888 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7889 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7892 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7893 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7895 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7896 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7897 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7898 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7899 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7900 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7901 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7902 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7905 c call transpose2(a2(1,1),a2t(1,1))
7908 crc print *,((prod_(i,j),i=1,2),j=1,2)
7909 crc print *,((prod(i,j),i=1,2),j=1,2)