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 c 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 caug8 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 cAug8 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 cAug8 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 cAug8 gelc(l,k)=gelc(l,k)+ggg(l)
2408 num_cont_hb(i)=num_conti
2410 cd write (iout,*) "Number of loop steps in EELEC:",ind
2412 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2413 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2415 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2416 ccc eel_loc=eel_loc+eello_turn3
2419 C-----------------------------------------------------------------------------
2420 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2421 C Third- and fourth-order contributions from turns
2422 implicit real*8 (a-h,o-z)
2423 include 'DIMENSIONS'
2424 include 'COMMON.IOUNITS'
2425 include 'COMMON.GEO'
2426 include 'COMMON.VAR'
2427 include 'COMMON.LOCAL'
2428 include 'COMMON.CHAIN'
2429 include 'COMMON.DERIV'
2430 include 'COMMON.INTERACT'
2431 include 'COMMON.CONTACTS'
2432 include 'COMMON.TORSION'
2433 include 'COMMON.VECTORS'
2434 include 'COMMON.FFIELD'
2435 include 'COMMON.CONTROL'
2437 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2438 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2439 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2440 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2441 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
2442 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2444 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2446 C Third-order contributions
2453 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2454 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2455 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2456 call transpose2(auxmat(1,1),auxmat1(1,1))
2457 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2458 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2459 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2460 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
2461 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2462 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2463 cd & ' eello_turn3_num',4*eello_turn3_num
2464 C Derivatives in gamma(i)
2465 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2466 call transpose2(auxmat2(1,1),auxmat3(1,1))
2467 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
2468 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2469 C Derivatives in gamma(i+1)
2470 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2471 call transpose2(auxmat2(1,1),auxmat3(1,1))
2472 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
2473 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2474 & +0.5d0*(pizda(1,1)+pizda(2,2))
2475 C Cartesian derivatives
2477 a_temp(1,1)=aggi(l,1)
2478 a_temp(1,2)=aggi(l,2)
2479 a_temp(2,1)=aggi(l,3)
2480 a_temp(2,2)=aggi(l,4)
2481 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2482 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2483 & +0.5d0*(pizda(1,1)+pizda(2,2))
2484 a_temp(1,1)=aggi1(l,1)
2485 a_temp(1,2)=aggi1(l,2)
2486 a_temp(2,1)=aggi1(l,3)
2487 a_temp(2,2)=aggi1(l,4)
2488 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2489 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2490 & +0.5d0*(pizda(1,1)+pizda(2,2))
2491 a_temp(1,1)=aggj(l,1)
2492 a_temp(1,2)=aggj(l,2)
2493 a_temp(2,1)=aggj(l,3)
2494 a_temp(2,2)=aggj(l,4)
2495 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2496 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2497 & +0.5d0*(pizda(1,1)+pizda(2,2))
2498 a_temp(1,1)=aggj1(l,1)
2499 a_temp(1,2)=aggj1(l,2)
2500 a_temp(2,1)=aggj1(l,3)
2501 a_temp(2,2)=aggj1(l,4)
2502 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2503 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2504 & +0.5d0*(pizda(1,1)+pizda(2,2))
2506 else if (j.eq.i+3) then
2507 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2509 C Fourth-order contributions
2517 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2518 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2519 iti1=itortyp(itype(i+1))
2520 iti2=itortyp(itype(i+2))
2521 iti3=itortyp(itype(i+3))
2522 call transpose2(EUg(1,1,i+1),e1t(1,1))
2523 call transpose2(Eug(1,1,i+2),e2t(1,1))
2524 call transpose2(Eug(1,1,i+3),e3t(1,1))
2525 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2526 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2527 s1=scalar2(b1(1,iti2),auxvec(1))
2528 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2529 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2530 s2=scalar2(b1(1,iti1),auxvec(1))
2531 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2532 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2533 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2534 eello_turn4=eello_turn4-(s1+s2+s3)
2535 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2536 & 'eturn4',i,j,-(s1+s2+s3)
2537 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2538 cd & ' eello_turn4_num',8*eello_turn4_num
2539 C Derivatives in gamma(i)
2540 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2541 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2542 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2543 s1=scalar2(b1(1,iti2),auxvec(1))
2544 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2545 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2546 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2547 C Derivatives in gamma(i+1)
2548 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2549 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2550 s2=scalar2(b1(1,iti1),auxvec(1))
2551 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2552 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2553 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2554 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2555 C Derivatives in gamma(i+2)
2556 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2557 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2558 s1=scalar2(b1(1,iti2),auxvec(1))
2559 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2560 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2561 s2=scalar2(b1(1,iti1),auxvec(1))
2562 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
2563 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
2564 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2565 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2566 C Cartesian derivatives
2567 C Derivatives of this turn contributions in DC(i+2)
2568 if (j.lt.nres-1) then
2570 a_temp(1,1)=agg(l,1)
2571 a_temp(1,2)=agg(l,2)
2572 a_temp(2,1)=agg(l,3)
2573 a_temp(2,2)=agg(l,4)
2574 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2575 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2576 s1=scalar2(b1(1,iti2),auxvec(1))
2577 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2578 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2579 s2=scalar2(b1(1,iti1),auxvec(1))
2580 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2581 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2582 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2584 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2587 C Remaining derivatives of this turn contribution
2589 a_temp(1,1)=aggi(l,1)
2590 a_temp(1,2)=aggi(l,2)
2591 a_temp(2,1)=aggi(l,3)
2592 a_temp(2,2)=aggi(l,4)
2593 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2594 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2595 s1=scalar2(b1(1,iti2),auxvec(1))
2596 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2597 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2598 s2=scalar2(b1(1,iti1),auxvec(1))
2599 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2600 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2601 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2602 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2603 a_temp(1,1)=aggi1(l,1)
2604 a_temp(1,2)=aggi1(l,2)
2605 a_temp(2,1)=aggi1(l,3)
2606 a_temp(2,2)=aggi1(l,4)
2607 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2608 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2609 s1=scalar2(b1(1,iti2),auxvec(1))
2610 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2611 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2612 s2=scalar2(b1(1,iti1),auxvec(1))
2613 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2614 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2615 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2616 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2617 a_temp(1,1)=aggj(l,1)
2618 a_temp(1,2)=aggj(l,2)
2619 a_temp(2,1)=aggj(l,3)
2620 a_temp(2,2)=aggj(l,4)
2621 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2622 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2623 s1=scalar2(b1(1,iti2),auxvec(1))
2624 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2625 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2626 s2=scalar2(b1(1,iti1),auxvec(1))
2627 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2628 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2629 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2630 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2631 a_temp(1,1)=aggj1(l,1)
2632 a_temp(1,2)=aggj1(l,2)
2633 a_temp(2,1)=aggj1(l,3)
2634 a_temp(2,2)=aggj1(l,4)
2635 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2636 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2637 s1=scalar2(b1(1,iti2),auxvec(1))
2638 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2639 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2640 s2=scalar2(b1(1,iti1),auxvec(1))
2641 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2642 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2643 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2644 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2649 C-----------------------------------------------------------------------------
2650 subroutine vecpr(u,v,w)
2651 implicit real*8(a-h,o-z)
2652 dimension u(3),v(3),w(3)
2653 w(1)=u(2)*v(3)-u(3)*v(2)
2654 w(2)=-u(1)*v(3)+u(3)*v(1)
2655 w(3)=u(1)*v(2)-u(2)*v(1)
2658 C-----------------------------------------------------------------------------
2659 subroutine unormderiv(u,ugrad,unorm,ungrad)
2660 C This subroutine computes the derivatives of a normalized vector u, given
2661 C the derivatives computed without normalization conditions, ugrad. Returns
2664 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2665 double precision vec(3)
2666 double precision scalar
2668 c write (2,*) 'ugrad',ugrad
2671 vec(i)=scalar(ugrad(1,i),u(1))
2673 c write (2,*) 'vec',vec
2676 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2679 c write (2,*) 'ungrad',ungrad
2682 C-----------------------------------------------------------------------------
2683 subroutine escp_soft_sphere(evdw2,evdw2_14)
2685 C This subroutine calculates the excluded-volume interaction energy between
2686 C peptide-group centers and side chains and its gradient in virtual-bond and
2687 C side-chain vectors.
2689 implicit real*8 (a-h,o-z)
2690 include 'DIMENSIONS'
2691 include 'COMMON.GEO'
2692 include 'COMMON.VAR'
2693 include 'COMMON.LOCAL'
2694 include 'COMMON.CHAIN'
2695 include 'COMMON.DERIV'
2696 include 'COMMON.INTERACT'
2697 include 'COMMON.FFIELD'
2698 include 'COMMON.IOUNITS'
2699 include 'COMMON.CONTROL'
2704 cd print '(a)','Enter ESCP'
2705 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
2706 do i=iatscp_s,iatscp_e
2708 xi=0.5D0*(c(1,i)+c(1,i+1))
2709 yi=0.5D0*(c(2,i)+c(2,i+1))
2710 zi=0.5D0*(c(3,i)+c(3,i+1))
2712 do iint=1,nscp_gr(i)
2714 do j=iscpstart(i,iint),iscpend(i,iint)
2716 C Uncomment following three lines for SC-p interactions
2720 C Uncomment following three lines for Ca-p interactions
2724 rij=xj*xj+yj*yj+zj*zj
2727 if (rij.lt.r0ijsq) then
2728 evdwij=0.25d0*(rij-r0ijsq)**2
2736 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2742 cd write (iout,*) 'j<i'
2743 C Uncomment following three lines for SC-p interactions
2745 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2748 cd write (iout,*) 'j>i'
2751 C Uncomment following line for SC-p interactions
2752 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2756 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2760 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2761 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2764 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2773 C-----------------------------------------------------------------------------
2774 subroutine escp(evdw2,evdw2_14)
2776 C This subroutine calculates the excluded-volume interaction energy between
2777 C peptide-group centers and side chains and its gradient in virtual-bond and
2778 C side-chain vectors.
2780 implicit real*8 (a-h,o-z)
2781 include 'DIMENSIONS'
2782 include 'COMMON.GEO'
2783 include 'COMMON.VAR'
2784 include 'COMMON.LOCAL'
2785 include 'COMMON.CHAIN'
2786 include 'COMMON.DERIV'
2787 include 'COMMON.INTERACT'
2788 include 'COMMON.FFIELD'
2789 include 'COMMON.IOUNITS'
2790 include 'COMMON.CONTROL'
2794 cd print '(a)','Enter ESCP'
2795 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
2796 do i=iatscp_s,iatscp_e
2798 xi=0.5D0*(c(1,i)+c(1,i+1))
2799 yi=0.5D0*(c(2,i)+c(2,i+1))
2800 zi=0.5D0*(c(3,i)+c(3,i+1))
2802 do iint=1,nscp_gr(i)
2804 do j=iscpstart(i,iint),iscpend(i,iint)
2806 C Uncomment following three lines for SC-p interactions
2810 C Uncomment following three lines for Ca-p interactions
2814 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2816 e1=fac*fac*aad(itypj,iteli)
2817 e2=fac*bad(itypj,iteli)
2818 if (iabs(j-i) .le. 2) then
2821 evdw2_14=evdw2_14+e1+e2
2825 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2826 & 'evdw2',i,j,evdwij
2828 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2830 fac=-(evdwij+e1)*rrij
2835 cd write (iout,*) 'j<i'
2836 C Uncomment following three lines for SC-p interactions
2838 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2841 cd write (iout,*) 'j>i'
2844 C Uncomment following line for SC-p interactions
2845 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2849 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2853 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2854 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2857 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2866 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2867 gradx_scp(j,i)=expon*gradx_scp(j,i)
2870 C******************************************************************************
2874 C To save time the factor EXPON has been extracted from ALL components
2875 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2878 C******************************************************************************
2881 C--------------------------------------------------------------------------
2882 subroutine edis(ehpb)
2884 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2886 implicit real*8 (a-h,o-z)
2887 include 'DIMENSIONS'
2888 include 'COMMON.SBRIDGE'
2889 include 'COMMON.CHAIN'
2890 include 'COMMON.DERIV'
2891 include 'COMMON.VAR'
2892 include 'COMMON.INTERACT'
2895 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2896 cd print *,'link_start=',link_start,' link_end=',link_end
2897 if (link_end.eq.0) return
2898 do i=link_start,link_end
2899 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2900 C CA-CA distance used in regularization of structure.
2903 C iii and jjj point to the residues for which the distance is assigned.
2904 if (ii.gt.nres) then
2911 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2912 C distance and angle dependent SS bond potential.
2913 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2914 call ssbond_ene(iii,jjj,eij)
2917 C Calculate the distance between the two points and its difference from the
2921 C Get the force constant corresponding to this distance.
2923 C Calculate the contribution to energy.
2924 ehpb=ehpb+waga*rdis*rdis
2926 C Evaluate gradient.
2929 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2930 cd & ' waga=',waga,' fac=',fac
2932 ggg(j)=fac*(c(j,jj)-c(j,ii))
2934 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2935 C If this is a SC-SC distance, we need to calculate the contributions to the
2936 C Cartesian gradient in the SC vectors (ghpbx).
2939 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2940 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2945 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2953 C--------------------------------------------------------------------------
2954 subroutine ssbond_ene(i,j,eij)
2956 C Calculate the distance and angle dependent SS-bond potential energy
2957 C using a free-energy function derived based on RHF/6-31G** ab initio
2958 C calculations of diethyl disulfide.
2960 C A. Liwo and U. Kozlowska, 11/24/03
2962 implicit real*8 (a-h,o-z)
2963 include 'DIMENSIONS'
2964 include 'COMMON.SBRIDGE'
2965 include 'COMMON.CHAIN'
2966 include 'COMMON.DERIV'
2967 include 'COMMON.LOCAL'
2968 include 'COMMON.INTERACT'
2969 include 'COMMON.VAR'
2970 include 'COMMON.IOUNITS'
2971 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2976 dxi=dc_norm(1,nres+i)
2977 dyi=dc_norm(2,nres+i)
2978 dzi=dc_norm(3,nres+i)
2979 dsci_inv=dsc_inv(itypi)
2981 dscj_inv=dsc_inv(itypj)
2985 dxj=dc_norm(1,nres+j)
2986 dyj=dc_norm(2,nres+j)
2987 dzj=dc_norm(3,nres+j)
2988 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2993 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2994 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2995 om12=dxi*dxj+dyi*dyj+dzi*dzj
2997 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2998 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3004 deltat12=om2-om1+2.0d0
3006 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3007 & +akct*deltad*deltat12
3008 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3009 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3010 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3011 c & " deltat12",deltat12," eij",eij
3012 ed=2*akcm*deltad+akct*deltat12
3014 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3015 eom1=-2*akth*deltat1-pom1-om2*pom2
3016 eom2= 2*akth*deltat2+pom1-om1*pom2
3019 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3022 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3023 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3024 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3025 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3028 C Calculate the components of the gradient in DC and X
3032 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3037 C--------------------------------------------------------------------------
3038 subroutine ebond(estr)
3040 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3042 implicit real*8 (a-h,o-z)
3043 include 'DIMENSIONS'
3044 include 'COMMON.LOCAL'
3045 include 'COMMON.GEO'
3046 include 'COMMON.INTERACT'
3047 include 'COMMON.DERIV'
3048 include 'COMMON.VAR'
3049 include 'COMMON.CHAIN'
3050 include 'COMMON.IOUNITS'
3051 include 'COMMON.NAMES'
3052 include 'COMMON.FFIELD'
3053 include 'COMMON.CONTROL'
3054 include 'COMMON.SETUP'
3055 double precision u(3),ud(3)
3057 do i=ibondp_start,ibondp_end
3058 diff = vbld(i)-vbldp0
3059 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3062 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3064 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
3068 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3070 do i=ibond_start,ibond_end
3075 diff=vbld(i+nres)-vbldsc0(1,iti)
3076 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3077 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3078 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3080 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3084 diff=vbld(i+nres)-vbldsc0(j,iti)
3085 ud(j)=aksc(j,iti)*diff
3086 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3100 uprod2=uprod2*u(k)*u(k)
3104 usumsqder=usumsqder+ud(j)*uprod2
3106 estr=estr+uprod/usum
3108 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3116 C--------------------------------------------------------------------------
3117 subroutine ebend(etheta)
3119 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3120 C angles gamma and its derivatives in consecutive thetas and gammas.
3122 implicit real*8 (a-h,o-z)
3123 include 'DIMENSIONS'
3124 include 'COMMON.LOCAL'
3125 include 'COMMON.GEO'
3126 include 'COMMON.INTERACT'
3127 include 'COMMON.DERIV'
3128 include 'COMMON.VAR'
3129 include 'COMMON.CHAIN'
3130 include 'COMMON.IOUNITS'
3131 include 'COMMON.NAMES'
3132 include 'COMMON.FFIELD'
3133 include 'COMMON.CONTROL'
3134 common /calcthet/ term1,term2,termm,diffak,ratak,
3135 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3136 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3137 double precision y(2),z(2)
3139 c time11=dexp(-2*time)
3142 c write (*,'(a,i2)') 'EBEND ICG=',icg
3143 do i=ithet_start,ithet_end
3144 C Zero the energy function and its derivative at 0 or pi.
3145 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3150 if (phii.ne.phii) phii=150.0
3163 if (phii1.ne.phii1) phii1=150.0
3175 C Calculate the "mean" value of theta from the part of the distribution
3176 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3177 C In following comments this theta will be referred to as t_c.
3178 thet_pred_mean=0.0d0
3182 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3184 dthett=thet_pred_mean*ssd
3185 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3186 C Derivatives of the "mean" values in gamma1 and gamma2.
3187 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3188 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3189 if (theta(i).gt.pi-delta) then
3190 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3192 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3193 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3194 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3196 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3198 else if (theta(i).lt.delta) then
3199 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3200 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3201 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3203 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3204 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3207 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3210 etheta=etheta+ethetai
3211 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
3213 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3214 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3215 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3217 C Ufff.... We've done all this!!!
3220 C---------------------------------------------------------------------------
3221 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3223 implicit real*8 (a-h,o-z)
3224 include 'DIMENSIONS'
3225 include 'COMMON.LOCAL'
3226 include 'COMMON.IOUNITS'
3227 common /calcthet/ term1,term2,termm,diffak,ratak,
3228 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3229 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3230 C Calculate the contributions to both Gaussian lobes.
3231 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3232 C The "polynomial part" of the "standard deviation" of this part of
3236 sig=sig*thet_pred_mean+polthet(j,it)
3238 C Derivative of the "interior part" of the "standard deviation of the"
3239 C gamma-dependent Gaussian lobe in t_c.
3240 sigtc=3*polthet(3,it)
3242 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3245 C Set the parameters of both Gaussian lobes of the distribution.
3246 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3247 fac=sig*sig+sigc0(it)
3250 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3251 sigsqtc=-4.0D0*sigcsq*sigtc
3252 c print *,i,sig,sigtc,sigsqtc
3253 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3254 sigtc=-sigtc/(fac*fac)
3255 C Following variable is sigma(t_c)**(-2)
3256 sigcsq=sigcsq*sigcsq
3258 sig0inv=1.0D0/sig0i**2
3259 delthec=thetai-thet_pred_mean
3260 delthe0=thetai-theta0i
3261 term1=-0.5D0*sigcsq*delthec*delthec
3262 term2=-0.5D0*sig0inv*delthe0*delthe0
3263 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3264 C NaNs in taking the logarithm. We extract the largest exponent which is added
3265 C to the energy (this being the log of the distribution) at the end of energy
3266 C term evaluation for this virtual-bond angle.
3267 if (term1.gt.term2) then
3269 term2=dexp(term2-termm)
3273 term1=dexp(term1-termm)
3276 C The ratio between the gamma-independent and gamma-dependent lobes of
3277 C the distribution is a Gaussian function of thet_pred_mean too.
3278 diffak=gthet(2,it)-thet_pred_mean
3279 ratak=diffak/gthet(3,it)**2
3280 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3281 C Let's differentiate it in thet_pred_mean NOW.
3283 C Now put together the distribution terms to make complete distribution.
3284 termexp=term1+ak*term2
3285 termpre=sigc+ak*sig0i
3286 C Contribution of the bending energy from this theta is just the -log of
3287 C the sum of the contributions from the two lobes and the pre-exponential
3288 C factor. Simple enough, isn't it?
3289 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3290 C NOW the derivatives!!!
3291 C 6/6/97 Take into account the deformation.
3292 E_theta=(delthec*sigcsq*term1
3293 & +ak*delthe0*sig0inv*term2)/termexp
3294 E_tc=((sigtc+aktc*sig0i)/termpre
3295 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3296 & aktc*term2)/termexp)
3299 c-----------------------------------------------------------------------------
3300 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3301 implicit real*8 (a-h,o-z)
3302 include 'DIMENSIONS'
3303 include 'COMMON.LOCAL'
3304 include 'COMMON.IOUNITS'
3305 common /calcthet/ term1,term2,termm,diffak,ratak,
3306 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3307 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3308 delthec=thetai-thet_pred_mean
3309 delthe0=thetai-theta0i
3310 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3311 t3 = thetai-thet_pred_mean
3315 t14 = t12+t6*sigsqtc
3317 t21 = thetai-theta0i
3323 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3324 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3325 & *(-t12*t9-ak*sig0inv*t27)
3329 C--------------------------------------------------------------------------
3330 subroutine ebend(etheta)
3332 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3333 C angles gamma and its derivatives in consecutive thetas and gammas.
3334 C ab initio-derived potentials from
3335 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3337 implicit real*8 (a-h,o-z)
3338 include 'DIMENSIONS'
3339 include 'COMMON.LOCAL'
3340 include 'COMMON.GEO'
3341 include 'COMMON.INTERACT'
3342 include 'COMMON.DERIV'
3343 include 'COMMON.VAR'
3344 include 'COMMON.CHAIN'
3345 include 'COMMON.IOUNITS'
3346 include 'COMMON.NAMES'
3347 include 'COMMON.FFIELD'
3348 include 'COMMON.CONTROL'
3349 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3350 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3351 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3352 & sinph1ph2(maxdouble,maxdouble)
3353 logical lprn /.false./, lprn1 /.false./
3355 do i=ithet_start,ithet_end
3359 theti2=0.5d0*theta(i)
3360 ityp2=ithetyp(itype(i-1))
3362 coskt(k)=dcos(k*theti2)
3363 sinkt(k)=dsin(k*theti2)
3368 if (phii.ne.phii) phii=150.0
3372 ityp1=ithetyp(itype(i-2))
3374 cosph1(k)=dcos(k*phii)
3375 sinph1(k)=dsin(k*phii)
3388 if (phii1.ne.phii1) phii1=150.0
3393 ityp3=ithetyp(itype(i))
3395 cosph2(k)=dcos(k*phii1)
3396 sinph2(k)=dsin(k*phii1)
3406 ethetai=aa0thet(ityp1,ityp2,ityp3)
3409 ccl=cosph1(l)*cosph2(k-l)
3410 ssl=sinph1(l)*sinph2(k-l)
3411 scl=sinph1(l)*cosph2(k-l)
3412 csl=cosph1(l)*sinph2(k-l)
3413 cosph1ph2(l,k)=ccl-ssl
3414 cosph1ph2(k,l)=ccl+ssl
3415 sinph1ph2(l,k)=scl+csl
3416 sinph1ph2(k,l)=scl-csl
3420 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3421 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3422 write (iout,*) "coskt and sinkt"
3424 write (iout,*) k,coskt(k),sinkt(k)
3428 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3429 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3432 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3433 & " ethetai",ethetai
3436 write (iout,*) "cosph and sinph"
3438 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3440 write (iout,*) "cosph1ph2 and sinph2ph2"
3443 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3444 & sinph1ph2(l,k),sinph1ph2(k,l)
3447 write(iout,*) "ethetai",ethetai
3451 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3452 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3453 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3454 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3455 ethetai=ethetai+sinkt(m)*aux
3456 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3457 dephii=dephii+k*sinkt(m)*(
3458 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3459 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3460 dephii1=dephii1+k*sinkt(m)*(
3461 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3462 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3464 & write (iout,*) "m",m," k",k," bbthet",
3465 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3466 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3467 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3468 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3472 & write(iout,*) "ethetai",ethetai
3476 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3477 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3478 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3479 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3480 ethetai=ethetai+sinkt(m)*aux
3481 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3482 dephii=dephii+l*sinkt(m)*(
3483 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3484 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3485 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3486 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3487 dephii1=dephii1+(k-l)*sinkt(m)*(
3488 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3489 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3490 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3491 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3493 write (iout,*) "m",m," k",k," l",l," ffthet",
3494 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3495 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3496 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3497 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3498 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3499 & cosph1ph2(k,l)*sinkt(m),
3500 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3506 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3507 & i,theta(i)*rad2deg,phii*rad2deg,
3508 & phii1*rad2deg,ethetai
3509 etheta=etheta+ethetai
3510 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3511 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3512 gloc(nphi+i-2,icg)=wang*dethetai
3518 c-----------------------------------------------------------------------------
3519 subroutine esc(escloc)
3520 C Calculate the local energy of a side chain and its derivatives in the
3521 C corresponding virtual-bond valence angles THETA and the spherical angles
3523 implicit real*8 (a-h,o-z)
3524 include 'DIMENSIONS'
3525 include 'COMMON.GEO'
3526 include 'COMMON.LOCAL'
3527 include 'COMMON.VAR'
3528 include 'COMMON.INTERACT'
3529 include 'COMMON.DERIV'
3530 include 'COMMON.CHAIN'
3531 include 'COMMON.IOUNITS'
3532 include 'COMMON.NAMES'
3533 include 'COMMON.FFIELD'
3534 include 'COMMON.CONTROL'
3535 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3536 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3537 common /sccalc/ time11,time12,time112,theti,it,nlobit
3540 c write (iout,'(a)') 'ESC'
3541 do i=loc_start,loc_end
3543 if (it.eq.10) goto 1
3545 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3546 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3547 theti=theta(i+1)-pipol
3552 if (x(2).gt.pi-delta) then
3556 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3558 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3559 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3561 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3562 & ddersc0(1),dersc(1))
3563 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3564 & ddersc0(3),dersc(3))
3566 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3568 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3569 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3570 & dersc0(2),esclocbi,dersc02)
3571 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3573 call splinthet(x(2),0.5d0*delta,ss,ssd)
3578 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3580 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3581 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3583 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3585 c write (iout,*) escloci
3586 else if (x(2).lt.delta) then
3590 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3592 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3593 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3595 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3596 & ddersc0(1),dersc(1))
3597 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3598 & ddersc0(3),dersc(3))
3600 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3602 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3603 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3604 & dersc0(2),esclocbi,dersc02)
3605 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3610 call splinthet(x(2),0.5d0*delta,ss,ssd)
3612 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3614 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3615 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3617 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3618 c write (iout,*) escloci
3620 call enesc(x,escloci,dersc,ddummy,.false.)
3623 escloc=escloc+escloci
3624 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
3625 & 'escloc',i,escloci
3626 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3628 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3630 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3631 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3636 C---------------------------------------------------------------------------
3637 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3638 implicit real*8 (a-h,o-z)
3639 include 'DIMENSIONS'
3640 include 'COMMON.GEO'
3641 include 'COMMON.LOCAL'
3642 include 'COMMON.IOUNITS'
3643 common /sccalc/ time11,time12,time112,theti,it,nlobit
3644 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3645 double precision contr(maxlob,-1:1)
3647 c write (iout,*) 'it=',it,' nlobit=',nlobit
3651 if (mixed) ddersc(j)=0.0d0
3655 C Because of periodicity of the dependence of the SC energy in omega we have
3656 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3657 C To avoid underflows, first compute & store the exponents.
3665 z(k)=x(k)-censc(k,j,it)
3670 Axk=Axk+gaussc(l,k,j,it)*z(l)
3676 expfac=expfac+Ax(k,j,iii)*z(k)
3684 C As in the case of ebend, we want to avoid underflows in exponentiation and
3685 C subsequent NaNs and INFs in energy calculation.
3686 C Find the largest exponent
3690 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3694 cd print *,'it=',it,' emin=',emin
3696 C Compute the contribution to SC energy and derivatives
3701 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
3702 if(adexp.ne.adexp) adexp=1.0
3705 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3707 cd print *,'j=',j,' expfac=',expfac
3708 escloc_i=escloc_i+expfac
3710 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3714 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3715 & +gaussc(k,2,j,it))*expfac
3722 dersc(1)=dersc(1)/cos(theti)**2
3723 ddersc(1)=ddersc(1)/cos(theti)**2
3726 escloci=-(dlog(escloc_i)-emin)
3728 dersc(j)=dersc(j)/escloc_i
3732 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3737 C------------------------------------------------------------------------------
3738 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3739 implicit real*8 (a-h,o-z)
3740 include 'DIMENSIONS'
3741 include 'COMMON.GEO'
3742 include 'COMMON.LOCAL'
3743 include 'COMMON.IOUNITS'
3744 common /sccalc/ time11,time12,time112,theti,it,nlobit
3745 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3746 double precision contr(maxlob)
3757 z(k)=x(k)-censc(k,j,it)
3763 Axk=Axk+gaussc(l,k,j,it)*z(l)
3769 expfac=expfac+Ax(k,j)*z(k)
3774 C As in the case of ebend, we want to avoid underflows in exponentiation and
3775 C subsequent NaNs and INFs in energy calculation.
3776 C Find the largest exponent
3779 if (emin.gt.contr(j)) emin=contr(j)
3783 C Compute the contribution to SC energy and derivatives
3787 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3788 escloc_i=escloc_i+expfac
3790 dersc(k)=dersc(k)+Ax(k,j)*expfac
3792 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3793 & +gaussc(1,2,j,it))*expfac
3797 dersc(1)=dersc(1)/cos(theti)**2
3798 dersc12=dersc12/cos(theti)**2
3799 escloci=-(dlog(escloc_i)-emin)
3801 dersc(j)=dersc(j)/escloc_i
3803 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3807 c----------------------------------------------------------------------------------
3808 subroutine esc(escloc)
3809 C Calculate the local energy of a side chain and its derivatives in the
3810 C corresponding virtual-bond valence angles THETA and the spherical angles
3811 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3812 C added by Urszula Kozlowska. 07/11/2007
3814 implicit real*8 (a-h,o-z)
3815 include 'DIMENSIONS'
3816 include 'COMMON.GEO'
3817 include 'COMMON.LOCAL'
3818 include 'COMMON.VAR'
3819 include 'COMMON.SCROT'
3820 include 'COMMON.INTERACT'
3821 include 'COMMON.DERIV'
3822 include 'COMMON.CHAIN'
3823 include 'COMMON.IOUNITS'
3824 include 'COMMON.NAMES'
3825 include 'COMMON.FFIELD'
3826 include 'COMMON.CONTROL'
3827 include 'COMMON.VECTORS'
3828 double precision x_prime(3),y_prime(3),z_prime(3)
3829 & , sumene,dsc_i,dp2_i,x(65),
3830 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3831 & de_dxx,de_dyy,de_dzz,de_dt
3832 double precision s1_t,s1_6_t,s2_t,s2_6_t
3834 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3835 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3836 & dt_dCi(3),dt_dCi1(3)
3837 common /sccalc/ time11,time12,time112,theti,it,nlobit
3840 do i=loc_start,loc_end
3841 costtab(i+1) =dcos(theta(i+1))
3842 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3843 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3844 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3845 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3846 cosfac=dsqrt(cosfac2)
3847 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3848 sinfac=dsqrt(sinfac2)
3850 if (it.eq.10) goto 1
3852 C Compute the axes of tghe local cartesian coordinates system; store in
3853 c x_prime, y_prime and z_prime
3860 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3861 C & dc_norm(3,i+nres)
3863 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3864 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3867 z_prime(j) = -uz(j,i-1)
3870 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3871 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3872 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3873 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3874 c & " xy",scalar(x_prime(1),y_prime(1)),
3875 c & " xz",scalar(x_prime(1),z_prime(1)),
3876 c & " yy",scalar(y_prime(1),y_prime(1)),
3877 c & " yz",scalar(y_prime(1),z_prime(1)),
3878 c & " zz",scalar(z_prime(1),z_prime(1))
3880 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3881 C to local coordinate system. Store in xx, yy, zz.
3887 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3888 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3889 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3896 C Compute the energy of the ith side cbain
3898 c write (2,*) "xx",xx," yy",yy," zz",zz
3901 x(j) = sc_parmin(j,it)
3904 Cc diagnostics - remove later
3906 yy1 = dsin(alph(2))*dcos(omeg(2))
3907 zz1 = -dsin(alph(2))*dsin(omeg(2))
3908 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3909 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3911 C," --- ", xx_w,yy_w,zz_w
3914 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3915 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3917 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3918 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3920 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3921 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3922 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3923 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3924 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3926 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3927 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3928 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3929 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3930 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3932 dsc_i = 0.743d0+x(61)
3934 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3935 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3936 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3937 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3938 s1=(1+x(63))/(0.1d0 + dscp1)
3939 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3940 s2=(1+x(65))/(0.1d0 + dscp2)
3941 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3942 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3943 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3944 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3946 c & dscp1,dscp2,sumene
3947 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3948 escloc = escloc + sumene
3949 c write (2,*) "i",i," escloc",sumene,escloc
3952 C This section to check the numerical derivatives of the energy of ith side
3953 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3954 C #define DEBUG in the code to turn it on.
3956 write (2,*) "sumene =",sumene
3960 write (2,*) xx,yy,zz
3961 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3962 de_dxx_num=(sumenep-sumene)/aincr
3964 write (2,*) "xx+ sumene from enesc=",sumenep
3967 write (2,*) xx,yy,zz
3968 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3969 de_dyy_num=(sumenep-sumene)/aincr
3971 write (2,*) "yy+ sumene from enesc=",sumenep
3974 write (2,*) xx,yy,zz
3975 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3976 de_dzz_num=(sumenep-sumene)/aincr
3978 write (2,*) "zz+ sumene from enesc=",sumenep
3979 costsave=cost2tab(i+1)
3980 sintsave=sint2tab(i+1)
3981 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3982 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3983 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3984 de_dt_num=(sumenep-sumene)/aincr
3985 write (2,*) " t+ sumene from enesc=",sumenep
3986 cost2tab(i+1)=costsave
3987 sint2tab(i+1)=sintsave
3988 C End of diagnostics section.
3991 C Compute the gradient of esc
3993 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
3994 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
3995 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
3996 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
3997 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
3998 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
3999 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4000 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4001 pom1=(sumene3*sint2tab(i+1)+sumene1)
4002 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4003 pom2=(sumene4*cost2tab(i+1)+sumene2)
4004 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4005 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4006 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4007 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4009 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4010 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4011 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4013 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4014 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4015 & +(pom1+pom2)*pom_dx
4017 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4020 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4021 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4022 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4024 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4025 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4026 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4027 & +x(59)*zz**2 +x(60)*xx*zz
4028 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4029 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4030 & +(pom1-pom2)*pom_dy
4032 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4035 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4036 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4037 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4038 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4039 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4040 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4041 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4042 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4044 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4047 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4048 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4049 & +pom1*pom_dt1+pom2*pom_dt2
4051 write(2,*), "de_dt = ", de_dt,de_dt_num
4055 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4056 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4057 cosfac2xx=cosfac2*xx
4058 sinfac2yy=sinfac2*yy
4060 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4062 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4064 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4065 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4066 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4067 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4068 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4069 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4070 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4071 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4072 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4073 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4077 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4078 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4081 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4082 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4083 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4085 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4086 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4090 dXX_Ctab(k,i)=dXX_Ci(k)
4091 dXX_C1tab(k,i)=dXX_Ci1(k)
4092 dYY_Ctab(k,i)=dYY_Ci(k)
4093 dYY_C1tab(k,i)=dYY_Ci1(k)
4094 dZZ_Ctab(k,i)=dZZ_Ci(k)
4095 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4096 dXX_XYZtab(k,i)=dXX_XYZ(k)
4097 dYY_XYZtab(k,i)=dYY_XYZ(k)
4098 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4102 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4103 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4104 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4105 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4106 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4108 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4109 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4110 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4111 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4112 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4113 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4114 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4115 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4117 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4118 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4120 C to check gradient call subroutine check_grad
4126 c------------------------------------------------------------------------------
4127 double precision function enesc(x,xx,yy,zz,cost2,sint2)
4129 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
4130 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
4131 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4132 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4134 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4135 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4137 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4138 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4139 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4140 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4141 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4143 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4144 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4145 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4146 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4147 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4149 dsc_i = 0.743d0+x(61)
4151 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4152 & *(xx*cost2+yy*sint2))
4153 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4154 & *(xx*cost2-yy*sint2))
4155 s1=(1+x(63))/(0.1d0 + dscp1)
4156 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4157 s2=(1+x(65))/(0.1d0 + dscp2)
4158 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4159 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
4160 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
4165 c------------------------------------------------------------------------------
4166 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4168 C This procedure calculates two-body contact function g(rij) and its derivative:
4171 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4174 C where x=(rij-r0ij)/delta
4176 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4179 double precision rij,r0ij,eps0ij,fcont,fprimcont
4180 double precision x,x2,x4,delta
4184 if (x.lt.-1.0D0) then
4187 else if (x.le.1.0D0) then
4190 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4191 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4198 c------------------------------------------------------------------------------
4199 subroutine splinthet(theti,delta,ss,ssder)
4200 implicit real*8 (a-h,o-z)
4201 include 'DIMENSIONS'
4202 include 'COMMON.VAR'
4203 include 'COMMON.GEO'
4206 if (theti.gt.pipol) then
4207 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4209 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4214 c------------------------------------------------------------------------------
4215 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4217 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4218 double precision ksi,ksi2,ksi3,a1,a2,a3
4219 a1=fprim0*delta/(f1-f0)
4225 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4226 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4229 c------------------------------------------------------------------------------
4230 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4232 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4233 double precision ksi,ksi2,ksi3,a1,a2,a3
4238 a2=3*(f1x-f0x)-2*fprim0x*delta
4239 a3=fprim0x*delta-2*(f1x-f0x)
4240 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4243 C-----------------------------------------------------------------------------
4245 C-----------------------------------------------------------------------------
4246 subroutine etor(etors,edihcnstr)
4247 implicit real*8 (a-h,o-z)
4248 include 'DIMENSIONS'
4249 include 'COMMON.VAR'
4250 include 'COMMON.GEO'
4251 include 'COMMON.LOCAL'
4252 include 'COMMON.TORSION'
4253 include 'COMMON.INTERACT'
4254 include 'COMMON.DERIV'
4255 include 'COMMON.CHAIN'
4256 include 'COMMON.NAMES'
4257 include 'COMMON.IOUNITS'
4258 include 'COMMON.FFIELD'
4259 include 'COMMON.TORCNSTR'
4260 include 'COMMON.CONTROL'
4262 C Set lprn=.true. for debugging
4266 do i=iphi_start,iphi_end
4268 itori=itortyp(itype(i-2))
4269 itori1=itortyp(itype(i-1))
4272 C Proline-Proline pair is a special case...
4273 if (itori.eq.3 .and. itori1.eq.3) then
4274 if (phii.gt.-dwapi3) then
4276 fac=1.0D0/(1.0D0-cosphi)
4277 etorsi=v1(1,3,3)*fac
4278 etorsi=etorsi+etorsi
4279 etors=etors+etorsi-v1(1,3,3)
4280 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
4281 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4284 v1ij=v1(j+1,itori,itori1)
4285 v2ij=v2(j+1,itori,itori1)
4288 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4289 if (energy_dec) etors_ii=etors_ii+
4290 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4291 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4295 v1ij=v1(j,itori,itori1)
4296 v2ij=v2(j,itori,itori1)
4299 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4300 if (energy_dec) etors_ii=etors_ii+
4301 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4302 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4305 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4308 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4309 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4310 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4311 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
4312 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4314 ! 6/20/98 - dihedral angle constraints
4317 itori=idih_constr(i)
4320 if (difi.gt.drange(i)) then
4322 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4323 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4324 else if (difi.lt.-drange(i)) then
4326 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4327 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4329 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4330 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4332 ! write (iout,*) 'edihcnstr',edihcnstr
4335 c------------------------------------------------------------------------------
4336 subroutine etor_d(etors_d)
4340 c----------------------------------------------------------------------------
4342 subroutine etor(etors,edihcnstr)
4343 implicit real*8 (a-h,o-z)
4344 include 'DIMENSIONS'
4345 include 'COMMON.VAR'
4346 include 'COMMON.GEO'
4347 include 'COMMON.LOCAL'
4348 include 'COMMON.TORSION'
4349 include 'COMMON.INTERACT'
4350 include 'COMMON.DERIV'
4351 include 'COMMON.CHAIN'
4352 include 'COMMON.NAMES'
4353 include 'COMMON.IOUNITS'
4354 include 'COMMON.FFIELD'
4355 include 'COMMON.TORCNSTR'
4356 include 'COMMON.CONTROL'
4358 C Set lprn=.true. for debugging
4362 do i=iphi_start,iphi_end
4364 itori=itortyp(itype(i-2))
4365 itori1=itortyp(itype(i-1))
4368 C Regular cosine and sine terms
4369 do j=1,nterm(itori,itori1)
4370 v1ij=v1(j,itori,itori1)
4371 v2ij=v2(j,itori,itori1)
4374 etors=etors+v1ij*cosphi+v2ij*sinphi
4375 if (energy_dec) etors_ii=etors_ii+
4376 & v1ij*cosphi+v2ij*sinphi
4377 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4381 C E = SUM ----------------------------------- - v1
4382 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4384 cosphi=dcos(0.5d0*phii)
4385 sinphi=dsin(0.5d0*phii)
4386 do j=1,nlor(itori,itori1)
4387 vl1ij=vlor1(j,itori,itori1)
4388 vl2ij=vlor2(j,itori,itori1)
4389 vl3ij=vlor3(j,itori,itori1)
4390 pom=vl2ij*cosphi+vl3ij*sinphi
4391 pom1=1.0d0/(pom*pom+1.0d0)
4392 etors=etors+vl1ij*pom1
4393 if (energy_dec) etors_ii=etors_ii+
4396 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4398 C Subtract the constant term
4399 etors=etors-v0(itori,itori1)
4400 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4401 & 'etor',i,etors_ii-v0(itori,itori1)
4403 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4404 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4405 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4406 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
4407 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4409 ! 6/20/98 - dihedral angle constraints
4411 c do i=1,ndih_constr
4412 do i=idihconstr_start,idihconstr_end
4413 itori=idih_constr(i)
4415 difi=pinorm(phii-phi0(i))
4416 if (difi.gt.drange(i)) then
4418 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4419 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4420 else if (difi.lt.-drange(i)) then
4422 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4423 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4427 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4428 cd & rad2deg*phi0(i), rad2deg*drange(i),
4429 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4431 cd write (iout,*) 'edihcnstr',edihcnstr
4434 c----------------------------------------------------------------------------
4435 subroutine etor_d(etors_d)
4436 C 6/23/01 Compute double torsional energy
4437 implicit real*8 (a-h,o-z)
4438 include 'DIMENSIONS'
4439 include 'COMMON.VAR'
4440 include 'COMMON.GEO'
4441 include 'COMMON.LOCAL'
4442 include 'COMMON.TORSION'
4443 include 'COMMON.INTERACT'
4444 include 'COMMON.DERIV'
4445 include 'COMMON.CHAIN'
4446 include 'COMMON.NAMES'
4447 include 'COMMON.IOUNITS'
4448 include 'COMMON.FFIELD'
4449 include 'COMMON.TORCNSTR'
4451 C Set lprn=.true. for debugging
4455 do i=iphid_start,iphid_end
4456 itori=itortyp(itype(i-2))
4457 itori1=itortyp(itype(i-1))
4458 itori2=itortyp(itype(i))
4463 C Regular cosine and sine terms
4464 do j=1,ntermd_1(itori,itori1,itori2)
4465 v1cij=v1c(1,j,itori,itori1,itori2)
4466 v1sij=v1s(1,j,itori,itori1,itori2)
4467 v2cij=v1c(2,j,itori,itori1,itori2)
4468 v2sij=v1s(2,j,itori,itori1,itori2)
4469 cosphi1=dcos(j*phii)
4470 sinphi1=dsin(j*phii)
4471 cosphi2=dcos(j*phii1)
4472 sinphi2=dsin(j*phii1)
4473 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4474 & v2cij*cosphi2+v2sij*sinphi2
4475 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4476 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4478 do k=2,ntermd_2(itori,itori1,itori2)
4480 v1cdij = v2c(k,l,itori,itori1,itori2)
4481 v2cdij = v2c(l,k,itori,itori1,itori2)
4482 v1sdij = v2s(k,l,itori,itori1,itori2)
4483 v2sdij = v2s(l,k,itori,itori1,itori2)
4484 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4485 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4486 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4487 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4488 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4489 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4490 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4491 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4492 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4493 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4496 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
4497 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
4502 c------------------------------------------------------------------------------
4503 subroutine eback_sc_corr(esccor)
4504 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4505 c conformational states; temporarily implemented as differences
4506 c between UNRES torsional potentials (dependent on three types of
4507 c residues) and the torsional potentials dependent on all 20 types
4508 c of residues computed from AM1 energy surfaces of terminally-blocked
4509 c amino-acid residues.
4510 implicit real*8 (a-h,o-z)
4511 include 'DIMENSIONS'
4512 include 'COMMON.VAR'
4513 include 'COMMON.GEO'
4514 include 'COMMON.LOCAL'
4515 include 'COMMON.TORSION'
4516 include 'COMMON.SCCOR'
4517 include 'COMMON.INTERACT'
4518 include 'COMMON.DERIV'
4519 include 'COMMON.CHAIN'
4520 include 'COMMON.NAMES'
4521 include 'COMMON.IOUNITS'
4522 include 'COMMON.FFIELD'
4523 include 'COMMON.CONTROL'
4525 C Set lprn=.true. for debugging
4528 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4530 do i=iphi_start,iphi_end
4537 v1ij=v1sccor(j,itori,itori1)
4538 v2ij=v2sccor(j,itori,itori1)
4541 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4542 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4545 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4546 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4547 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
4548 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4552 c----------------------------------------------------------------------------
4553 subroutine multibody(ecorr)
4554 C This subroutine calculates multi-body contributions to energy following
4555 C the idea of Skolnick et al. If side chains I and J make a contact and
4556 C at the same time side chains I+1 and J+1 make a contact, an extra
4557 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4558 implicit real*8 (a-h,o-z)
4559 include 'DIMENSIONS'
4560 include 'COMMON.IOUNITS'
4561 include 'COMMON.DERIV'
4562 include 'COMMON.INTERACT'
4563 include 'COMMON.CONTACTS'
4564 double precision gx(3),gx1(3)
4567 C Set lprn=.true. for debugging
4571 write (iout,'(a)') 'Contact function values:'
4573 write (iout,'(i2,20(1x,i2,f10.5))')
4574 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4589 num_conti=num_cont(i)
4590 num_conti1=num_cont(i1)
4595 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4596 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4597 cd & ' ishift=',ishift
4598 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4599 C The system gains extra energy.
4600 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4601 endif ! j1==j+-ishift
4610 c------------------------------------------------------------------------------
4611 double precision function esccorr(i,j,k,l,jj,kk)
4612 implicit real*8 (a-h,o-z)
4613 include 'DIMENSIONS'
4614 include 'COMMON.IOUNITS'
4615 include 'COMMON.DERIV'
4616 include 'COMMON.INTERACT'
4617 include 'COMMON.CONTACTS'
4618 double precision gx(3),gx1(3)
4623 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4624 C Calculate the multi-body contribution to energy.
4625 C Calculate multi-body contributions to the gradient.
4626 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4627 cd & k,l,(gacont(m,kk,k),m=1,3)
4629 gx(m) =ekl*gacont(m,jj,i)
4630 gx1(m)=eij*gacont(m,kk,k)
4631 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4632 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4633 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4634 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4638 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4643 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4649 c------------------------------------------------------------------------------
4651 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4652 implicit real*8 (a-h,o-z)
4653 include 'DIMENSIONS'
4654 integer dimen1,dimen2,atom,indx
4655 double precision buffer(dimen1,dimen2)
4656 double precision zapas
4657 common /contacts_hb/ zapas(3,maxconts,maxres,8),
4658 & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
4659 & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
4660 & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
4661 num_kont=num_cont_hb(atom)
4665 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4668 buffer(i,indx+25)=facont_hb(i,atom)
4669 buffer(i,indx+26)=ees0p(i,atom)
4670 buffer(i,indx+27)=ees0m(i,atom)
4671 buffer(i,indx+28)=d_cont(i,atom)
4672 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
4674 buffer(1,indx+30)=dfloat(num_kont)
4677 c------------------------------------------------------------------------------
4678 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4679 implicit real*8 (a-h,o-z)
4680 include 'DIMENSIONS'
4681 integer dimen1,dimen2,atom,indx
4682 double precision buffer(dimen1,dimen2)
4683 double precision zapas
4684 common /contacts_hb/ zapas(3,maxconts,maxres,8),
4685 & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
4686 & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
4687 & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
4688 num_kont=buffer(1,indx+30)
4689 num_kont_old=num_cont_hb(atom)
4690 num_cont_hb(atom)=num_kont+num_kont_old
4695 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4698 facont_hb(ii,atom)=buffer(i,indx+25)
4699 ees0p(ii,atom)=buffer(i,indx+26)
4700 ees0m(ii,atom)=buffer(i,indx+27)
4701 d_cont(i,atom)=buffer(i,indx+28)
4702 jcont_hb(ii,atom)=buffer(i,indx+29)
4706 c------------------------------------------------------------------------------
4708 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4709 C This subroutine calculates multi-body contributions to hydrogen-bonding
4710 implicit real*8 (a-h,o-z)
4711 include 'DIMENSIONS'
4712 include 'COMMON.IOUNITS'
4715 parameter (max_cont=maxconts)
4716 parameter (max_dim=2*(8*3+6))
4717 parameter (msglen1=max_cont*max_dim)
4718 parameter (msglen2=2*msglen1)
4719 integer source,CorrelType,CorrelID,Error
4720 double precision buffer(max_cont,max_dim)
4721 integer status(MPI_STATUS_SIZE)
4723 include 'COMMON.SETUP'
4724 include 'COMMON.FFIELD'
4725 include 'COMMON.DERIV'
4726 include 'COMMON.INTERACT'
4727 include 'COMMON.CONTACTS'
4728 include 'COMMON.CONTROL'
4729 double precision gx(3),gx1(3),time00
4732 C Set lprn=.true. for debugging
4737 if (nfgtasks.le.1) goto 30
4739 write (iout,'(a)') 'Contact function values:'
4741 write (iout,'(2i3,50(1x,i2,f5.2))')
4742 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4743 & j=1,num_cont_hb(i))
4746 C Caution! Following code assumes that electrostatic interactions concerning
4747 C a given atom are split among at most two processors!
4757 c write (*,*) 'MyRank',MyRank,' mm',mm
4760 c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4761 if (fg_rank.gt.0) then
4762 C Send correlation contributions to the preceding processor
4764 nn=num_cont_hb(iatel_s)
4765 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4766 c write (*,*) 'The BUFFER array:'
4768 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
4770 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4772 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
4773 C Clear the contacts of the atom passed to the neighboring processor
4774 nn=num_cont_hb(iatel_s+1)
4776 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
4778 num_cont_hb(iatel_s)=0
4780 cd write (iout,*) 'Processor ',fg_rank,MyRank,
4781 cd & ' is sending correlation contribution to processor',fg_rank-1,
4782 cd & ' msglen=',msglen
4783 c write (*,*) 'Processor ',fg_rank,MyRank,
4784 c & ' is sending correlation contribution to processor',fg_rank-1,
4785 c & ' msglen=',msglen,' CorrelType=',CorrelType
4787 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
4788 & CorrelType,FG_COMM,IERROR)
4789 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
4790 cd write (iout,*) 'Processor ',fg_rank,
4791 cd & ' has sent correlation contribution to processor',fg_rank-1,
4792 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4793 c write (*,*) 'Processor ',fg_rank,
4794 c & ' has sent correlation contribution to processor',fg_rank-1,
4795 c & ' msglen=',msglen,' CorrelID=',CorrelID
4797 endif ! (fg_rank.gt.0)
4801 c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4802 if (fg_rank.lt.nfgtasks-1) then
4803 C Receive correlation contributions from the next processor
4805 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4806 cd write (iout,*) 'Processor',fg_rank,
4807 cd & ' is receiving correlation contribution from processor',fg_rank+1,
4808 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4809 c write (*,*) 'Processor',fg_rank,
4810 c &' is receiving correlation contribution from processor',fg_rank+1,
4811 c & ' msglen=',msglen,' CorrelType=',CorrelType
4814 do while (nbytes.le.0)
4815 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
4816 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
4818 c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
4819 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
4820 & fg_rank+1,CorrelType,FG_COMM,status,IERROR)
4821 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
4822 c write (*,*) 'Processor',fg_rank,
4823 c &' has received correlation contribution from processor',fg_rank+1,
4824 c & ' msglen=',msglen,' nbytes=',nbytes
4825 c write (*,*) 'The received BUFFER array:'
4827 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
4829 if (msglen.eq.msglen1) then
4830 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4831 else if (msglen.eq.msglen2) then
4832 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4833 call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
4836 & 'ERROR!!!! message length changed while processing correlations.'
4838 & 'ERROR!!!! message length changed while processing correlations.'
4839 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
4840 endif ! msglen.eq.msglen1
4841 endif ! fg_rank.lt.nfgtasks-1
4848 write (iout,'(a)') 'Contact function values:'
4850 write (iout,'(2i3,50(1x,i2,f5.2))')
4851 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4852 & j=1,num_cont_hb(i))
4856 C Remove the loop below after debugging !!!
4863 C Calculate the local-electrostatic correlation terms
4864 do i=iatel_s,iatel_e+1
4866 num_conti=num_cont_hb(i)
4867 num_conti1=num_cont_hb(i+1)
4872 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4873 c & ' jj=',jj,' kk=',kk
4874 if (j1.eq.j+1 .or. j1.eq.j-1) then
4875 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4876 C The system gains extra energy.
4877 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4878 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4879 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4881 else if (j1.eq.j) then
4882 C Contacts I-J and I-(J+1) occur simultaneously.
4883 C The system loses extra energy.
4884 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4889 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4890 c & ' jj=',jj,' kk=',kk
4892 C Contacts I-J and (I+1)-J occur simultaneously.
4893 C The system loses extra energy.
4894 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4901 c------------------------------------------------------------------------------
4902 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4904 C This subroutine calculates multi-body contributions to hydrogen-bonding
4905 implicit real*8 (a-h,o-z)
4906 include 'DIMENSIONS'
4907 include 'COMMON.IOUNITS'
4910 parameter (max_cont=maxconts)
4911 parameter (max_dim=2*(8*3+6))
4912 c parameter (msglen1=max_cont*max_dim*4)
4913 parameter (msglen1=max_cont*max_dim/2)
4914 parameter (msglen2=2*msglen1)
4915 integer source,CorrelType,CorrelID,Error
4916 double precision buffer(max_cont,max_dim)
4917 integer status(MPI_STATUS_SIZE)
4919 include 'COMMON.SETUP'
4920 include 'COMMON.FFIELD'
4921 include 'COMMON.DERIV'
4922 include 'COMMON.INTERACT'
4923 include 'COMMON.CONTACTS'
4924 include 'COMMON.CONTROL'
4925 double precision gx(3),gx1(3)
4927 C Set lprn=.true. for debugging
4933 if (fgProcs.le.1) goto 30
4935 write (iout,'(a)') 'Contact function values:'
4937 write (iout,'(2i3,50(1x,i2,f5.2))')
4938 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4939 & j=1,num_cont_hb(i))
4942 C Caution! Following code assumes that electrostatic interactions concerning
4943 C a given atom are split among at most two processors!
4953 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4956 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4957 if (MyRank.gt.0) then
4958 C Send correlation contributions to the preceding processor
4960 nn=num_cont_hb(iatel_s)
4961 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4962 cd write (iout,*) 'The BUFFER array:'
4964 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
4966 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4968 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
4969 C Clear the contacts of the atom passed to the neighboring processor
4970 nn=num_cont_hb(iatel_s+1)
4972 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
4974 num_cont_hb(iatel_s)=0
4976 cd write (*,*) 'Processor ',fg_rank,MyRank,
4977 cd & ' is sending correlation contribution to processor',fg_rank-1,
4978 cd & ' msglen=',msglen
4979 cd write (*,*) 'Processor ',MyID,MyRank,
4980 cd & ' is sending correlation contribution to processor',fg_rank-1,
4981 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4983 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
4984 & CorrelType,FG_COMM,IERROR)
4985 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
4986 cd write (*,*) 'Processor ',fg_rank,MyRank,
4987 cd & ' has sent correlation contribution to processor',fg_rank-1,
4988 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4989 cd write (*,*) 'Processor ',fg_rank,
4990 cd & ' has sent correlation contribution to processor',fg_rank-1,
4991 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4993 endif ! (MyRank.gt.0)
4997 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4998 if (fg_rank.lt.nfgtasks-1) then
4999 C Receive correlation contributions from the next processor
5001 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5002 cd write (iout,*) 'Processor',fg_rank,
5003 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5004 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5005 cd write (*,*) 'Processor',fg_rank,
5006 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5007 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5010 do while (nbytes.le.0)
5011 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5012 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5014 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5015 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5016 & fg_rank+1,CorrelType,status,IERROR)
5017 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5018 cd write (iout,*) 'Processor',fg_rank,
5019 cd & ' has received correlation contribution from processor',fg_rank+1,
5020 cd & ' msglen=',msglen,' nbytes=',nbytes
5021 cd write (iout,*) 'The received BUFFER array:'
5023 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5025 if (msglen.eq.msglen1) then
5026 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5027 else if (msglen.eq.msglen2) then
5028 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5029 call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5032 & 'ERROR!!!! message length changed while processing correlations.'
5034 & 'ERROR!!!! message length changed while processing correlations.'
5035 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5036 endif ! msglen.eq.msglen1
5037 endif ! fg_rank.lt.nfgtasks-1
5044 write (iout,'(a)') 'Contact function values:'
5046 write (iout,'(2i3,50(1x,i2,f5.2))')
5047 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5048 & j=1,num_cont_hb(i))
5054 C Remove the loop below after debugging !!!
5061 C Calculate the dipole-dipole interaction energies
5062 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5063 do i=iatel_s,iatel_e+1
5064 num_conti=num_cont_hb(i)
5073 C Calculate the local-electrostatic correlation terms
5074 do i=iatel_s,iatel_e+1
5076 num_conti=num_cont_hb(i)
5077 num_conti1=num_cont_hb(i+1)
5082 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5083 c & ' jj=',jj,' kk=',kk
5084 if (j1.eq.j+1 .or. j1.eq.j-1) then
5085 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5086 C The system gains extra energy.
5088 sqd1=dsqrt(d_cont(jj,i))
5089 sqd2=dsqrt(d_cont(kk,i1))
5090 sred_geom = sqd1*sqd2
5091 IF (sred_geom.lt.cutoff_corr) THEN
5092 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5094 cd write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5095 cd & ' jj=',jj,' kk=',kk
5096 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5097 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5099 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5100 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5103 cd write (iout,*) 'sred_geom=',sred_geom,
5104 cd & ' ekont=',ekont,' fprim=',fprimcont
5105 call calc_eello(i,j,i+1,j1,jj,kk)
5106 if (wcorr4.gt.0.0d0)
5107 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5108 if (energy_dec.and.wcorr4.gt.0.0d0)
5109 1 write (iout,'(a6,2i5,0pf7.3)')
5110 2 'ecorr4',i,j,eello4(i,j,i+1,j1,jj,kk)
5111 if (wcorr5.gt.0.0d0)
5112 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5113 if (energy_dec.and.wcorr5.gt.0.0d0)
5114 1 write (iout,'(a6,2i5,0pf7.3)')
5115 2 'ecorr5',i,j,eello5(i,j,i+1,j1,jj,kk)
5116 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5117 cd write(2,*)'ijkl',i,j,i+1,j1
5118 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5119 & .or. wturn6.eq.0.0d0))then
5120 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5121 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5122 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5123 1 'ecorr6',i,j,eello6(i,j,i+1,j1,jj,kk)
5124 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5125 cd & 'ecorr6=',ecorr6
5126 cd write (iout,'(4e15.5)') sred_geom,
5127 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5128 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5129 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5130 else if (wturn6.gt.0.0d0
5131 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5132 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5133 eturn6=eturn6+eello_turn6(i,jj,kk)
5134 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5135 1 'eturn6',i,j,eello_turn6(i,jj,kk)
5136 cd write (2,*) 'multibody_eello:eturn6',eturn6
5140 else if (j1.eq.j) then
5141 C Contacts I-J and I-(J+1) occur simultaneously.
5142 C The system loses extra energy.
5143 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5148 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5149 c & ' jj=',jj,' kk=',kk
5151 C Contacts I-J and (I+1)-J occur simultaneously.
5152 C The system loses extra energy.
5153 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5160 c------------------------------------------------------------------------------
5161 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5162 implicit real*8 (a-h,o-z)
5163 include 'DIMENSIONS'
5164 include 'COMMON.IOUNITS'
5165 include 'COMMON.DERIV'
5166 include 'COMMON.INTERACT'
5167 include 'COMMON.CONTACTS'
5168 double precision gx(3),gx1(3)
5178 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5179 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5180 C Following 4 lines for diagnostics.
5185 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5187 c write (iout,*)'Contacts have occurred for peptide groups',
5188 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5189 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5190 C Calculate the multi-body contribution to energy.
5191 ecorr=ecorr+ekont*ees
5192 C Calculate multi-body contributions to the gradient.
5194 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5195 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5196 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5197 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5198 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5199 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5200 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5201 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5202 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5203 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5204 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5205 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5206 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5207 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5211 gradcorr(ll,m)=gradcorr(ll,m)+
5212 & ees*ekl*gacont_hbr(ll,jj,i)-
5213 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5214 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5219 gradcorr(ll,m)=gradcorr(ll,m)+
5220 & ees*eij*gacont_hbr(ll,kk,k)-
5221 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5222 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5229 C---------------------------------------------------------------------------
5230 subroutine dipole(i,j,jj)
5231 implicit real*8 (a-h,o-z)
5232 include 'DIMENSIONS'
5233 include 'COMMON.IOUNITS'
5234 include 'COMMON.CHAIN'
5235 include 'COMMON.FFIELD'
5236 include 'COMMON.DERIV'
5237 include 'COMMON.INTERACT'
5238 include 'COMMON.CONTACTS'
5239 include 'COMMON.TORSION'
5240 include 'COMMON.VAR'
5241 include 'COMMON.GEO'
5242 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5244 iti1 = itortyp(itype(i+1))
5245 if (j.lt.nres-1) then
5246 itj1 = itortyp(itype(j+1))
5251 dipi(iii,1)=Ub2(iii,i)
5252 dipderi(iii)=Ub2der(iii,i)
5253 dipi(iii,2)=b1(iii,iti1)
5254 dipj(iii,1)=Ub2(iii,j)
5255 dipderj(iii)=Ub2der(iii,j)
5256 dipj(iii,2)=b1(iii,itj1)
5260 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5263 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5270 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5274 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5279 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5280 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5282 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5284 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5286 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5291 C---------------------------------------------------------------------------
5292 subroutine calc_eello(i,j,k,l,jj,kk)
5294 C This subroutine computes matrices and vectors needed to calculate
5295 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5297 implicit real*8 (a-h,o-z)
5298 include 'DIMENSIONS'
5299 include 'COMMON.IOUNITS'
5300 include 'COMMON.CHAIN'
5301 include 'COMMON.DERIV'
5302 include 'COMMON.INTERACT'
5303 include 'COMMON.CONTACTS'
5304 include 'COMMON.TORSION'
5305 include 'COMMON.VAR'
5306 include 'COMMON.GEO'
5307 include 'COMMON.FFIELD'
5308 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5309 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5312 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5313 cd & ' jj=',jj,' kk=',kk
5314 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5317 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5318 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5321 call transpose2(aa1(1,1),aa1t(1,1))
5322 call transpose2(aa2(1,1),aa2t(1,1))
5325 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5326 & aa1tder(1,1,lll,kkk))
5327 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5328 & aa2tder(1,1,lll,kkk))
5332 C parallel orientation of the two CA-CA-CA frames.
5334 iti=itortyp(itype(i))
5338 itk1=itortyp(itype(k+1))
5339 itj=itortyp(itype(j))
5340 if (l.lt.nres-1) then
5341 itl1=itortyp(itype(l+1))
5345 C A1 kernel(j+1) A2T
5347 cd write (iout,'(3f10.5,5x,3f10.5)')
5348 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5350 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5351 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5352 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5353 C Following matrices are needed only for 6-th order cumulants
5354 IF (wcorr6.gt.0.0d0) THEN
5355 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5356 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5357 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5358 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5359 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5360 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5361 & ADtEAderx(1,1,1,1,1,1))
5363 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5364 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5365 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5366 & ADtEA1derx(1,1,1,1,1,1))
5368 C End 6-th order cumulants
5371 cd write (2,*) 'In calc_eello6'
5373 cd write (2,*) 'iii=',iii
5375 cd write (2,*) 'kkk=',kkk
5377 cd write (2,'(3(2f10.5),5x)')
5378 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5383 call transpose2(EUgder(1,1,k),auxmat(1,1))
5384 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5385 call transpose2(EUg(1,1,k),auxmat(1,1))
5386 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5387 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5391 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5392 & EAEAderx(1,1,lll,kkk,iii,1))
5396 C A1T kernel(i+1) A2
5397 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5398 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5399 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5400 C Following matrices are needed only for 6-th order cumulants
5401 IF (wcorr6.gt.0.0d0) THEN
5402 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5403 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5404 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5405 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5406 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5407 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5408 & ADtEAderx(1,1,1,1,1,2))
5409 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5410 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5411 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5412 & ADtEA1derx(1,1,1,1,1,2))
5414 C End 6-th order cumulants
5415 call transpose2(EUgder(1,1,l),auxmat(1,1))
5416 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5417 call transpose2(EUg(1,1,l),auxmat(1,1))
5418 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5419 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5423 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5424 & EAEAderx(1,1,lll,kkk,iii,2))
5429 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5430 C They are needed only when the fifth- or the sixth-order cumulants are
5432 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5433 call transpose2(AEA(1,1,1),auxmat(1,1))
5434 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5435 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5436 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5437 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5438 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5439 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5440 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5441 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5442 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5443 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5444 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5445 call transpose2(AEA(1,1,2),auxmat(1,1))
5446 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5447 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5448 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5449 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5450 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5451 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5452 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5453 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5454 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5455 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5456 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5457 C Calculate the Cartesian derivatives of the vectors.
5461 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5462 call matvec2(auxmat(1,1),b1(1,iti),
5463 & AEAb1derx(1,lll,kkk,iii,1,1))
5464 call matvec2(auxmat(1,1),Ub2(1,i),
5465 & AEAb2derx(1,lll,kkk,iii,1,1))
5466 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5467 & AEAb1derx(1,lll,kkk,iii,2,1))
5468 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5469 & AEAb2derx(1,lll,kkk,iii,2,1))
5470 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5471 call matvec2(auxmat(1,1),b1(1,itj),
5472 & AEAb1derx(1,lll,kkk,iii,1,2))
5473 call matvec2(auxmat(1,1),Ub2(1,j),
5474 & AEAb2derx(1,lll,kkk,iii,1,2))
5475 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5476 & AEAb1derx(1,lll,kkk,iii,2,2))
5477 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5478 & AEAb2derx(1,lll,kkk,iii,2,2))
5485 C Antiparallel orientation of the two CA-CA-CA frames.
5487 iti=itortyp(itype(i))
5491 itk1=itortyp(itype(k+1))
5492 itl=itortyp(itype(l))
5493 itj=itortyp(itype(j))
5494 if (j.lt.nres-1) then
5495 itj1=itortyp(itype(j+1))
5499 C A2 kernel(j-1)T A1T
5500 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5501 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5502 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5503 C Following matrices are needed only for 6-th order cumulants
5504 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5505 & j.eq.i+4 .and. l.eq.i+3)) THEN
5506 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5507 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5508 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5509 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5510 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5511 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5512 & ADtEAderx(1,1,1,1,1,1))
5513 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5514 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5515 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5516 & ADtEA1derx(1,1,1,1,1,1))
5518 C End 6-th order cumulants
5519 call transpose2(EUgder(1,1,k),auxmat(1,1))
5520 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5521 call transpose2(EUg(1,1,k),auxmat(1,1))
5522 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5523 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5527 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5528 & EAEAderx(1,1,lll,kkk,iii,1))
5532 C A2T kernel(i+1)T A1
5533 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5534 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5535 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5536 C Following matrices are needed only for 6-th order cumulants
5537 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5538 & j.eq.i+4 .and. l.eq.i+3)) THEN
5539 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5540 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5541 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5542 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5543 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5544 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5545 & ADtEAderx(1,1,1,1,1,2))
5546 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5547 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5548 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5549 & ADtEA1derx(1,1,1,1,1,2))
5551 C End 6-th order cumulants
5552 call transpose2(EUgder(1,1,j),auxmat(1,1))
5553 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5554 call transpose2(EUg(1,1,j),auxmat(1,1))
5555 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5556 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5560 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5561 & EAEAderx(1,1,lll,kkk,iii,2))
5566 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5567 C They are needed only when the fifth- or the sixth-order cumulants are
5569 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5570 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5571 call transpose2(AEA(1,1,1),auxmat(1,1))
5572 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5573 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5574 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5575 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5576 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5577 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5578 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5579 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5580 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5581 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5582 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5583 call transpose2(AEA(1,1,2),auxmat(1,1))
5584 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5585 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5586 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5587 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5588 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5589 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5590 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5591 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5592 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5593 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5594 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5595 C Calculate the Cartesian derivatives of the vectors.
5599 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5600 call matvec2(auxmat(1,1),b1(1,iti),
5601 & AEAb1derx(1,lll,kkk,iii,1,1))
5602 call matvec2(auxmat(1,1),Ub2(1,i),
5603 & AEAb2derx(1,lll,kkk,iii,1,1))
5604 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5605 & AEAb1derx(1,lll,kkk,iii,2,1))
5606 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5607 & AEAb2derx(1,lll,kkk,iii,2,1))
5608 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5609 call matvec2(auxmat(1,1),b1(1,itl),
5610 & AEAb1derx(1,lll,kkk,iii,1,2))
5611 call matvec2(auxmat(1,1),Ub2(1,l),
5612 & AEAb2derx(1,lll,kkk,iii,1,2))
5613 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5614 & AEAb1derx(1,lll,kkk,iii,2,2))
5615 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5616 & AEAb2derx(1,lll,kkk,iii,2,2))
5625 C---------------------------------------------------------------------------
5626 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5627 & KK,KKderg,AKA,AKAderg,AKAderx)
5631 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5632 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5633 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5638 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5640 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5643 cd if (lprn) write (2,*) 'In kernel'
5645 cd if (lprn) write (2,*) 'kkk=',kkk
5647 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5648 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5650 cd write (2,*) 'lll=',lll
5651 cd write (2,*) 'iii=1'
5653 cd write (2,'(3(2f10.5),5x)')
5654 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5657 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5658 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5660 cd write (2,*) 'lll=',lll
5661 cd write (2,*) 'iii=2'
5663 cd write (2,'(3(2f10.5),5x)')
5664 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5671 C---------------------------------------------------------------------------
5672 double precision function eello4(i,j,k,l,jj,kk)
5673 implicit real*8 (a-h,o-z)
5674 include 'DIMENSIONS'
5675 include 'COMMON.IOUNITS'
5676 include 'COMMON.CHAIN'
5677 include 'COMMON.DERIV'
5678 include 'COMMON.INTERACT'
5679 include 'COMMON.CONTACTS'
5680 include 'COMMON.TORSION'
5681 include 'COMMON.VAR'
5682 include 'COMMON.GEO'
5683 double precision pizda(2,2),ggg1(3),ggg2(3)
5684 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5688 cd print *,'eello4:',i,j,k,l,jj,kk
5689 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5690 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5691 cold eij=facont_hb(jj,i)
5692 cold ekl=facont_hb(kk,k)
5694 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5695 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5696 gcorr_loc(k-1)=gcorr_loc(k-1)
5697 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5699 gcorr_loc(l-1)=gcorr_loc(l-1)
5700 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5702 gcorr_loc(j-1)=gcorr_loc(j-1)
5703 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5708 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5709 & -EAEAderx(2,2,lll,kkk,iii,1)
5710 cd derx(lll,kkk,iii)=0.0d0
5714 cd gcorr_loc(l-1)=0.0d0
5715 cd gcorr_loc(j-1)=0.0d0
5716 cd gcorr_loc(k-1)=0.0d0
5718 cd write (iout,*)'Contacts have occurred for peptide groups',
5719 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5720 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5721 if (j.lt.nres-1) then
5728 if (l.lt.nres-1) then
5736 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5737 ggg1(ll)=eel4*g_contij(ll,1)
5738 ggg2(ll)=eel4*g_contij(ll,2)
5739 ghalf=0.5d0*ggg1(ll)
5741 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5742 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5743 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5744 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5745 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5746 ghalf=0.5d0*ggg2(ll)
5748 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5749 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5750 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5751 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5756 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5757 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5762 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5763 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5769 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5774 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5778 cd write (2,*) iii,gcorr_loc(iii)
5781 cd write (2,*) 'ekont',ekont
5782 cd write (iout,*) 'eello4',ekont*eel4
5785 C---------------------------------------------------------------------------
5786 double precision function eello5(i,j,k,l,jj,kk)
5787 implicit real*8 (a-h,o-z)
5788 include 'DIMENSIONS'
5789 include 'COMMON.IOUNITS'
5790 include 'COMMON.CHAIN'
5791 include 'COMMON.DERIV'
5792 include 'COMMON.INTERACT'
5793 include 'COMMON.CONTACTS'
5794 include 'COMMON.TORSION'
5795 include 'COMMON.VAR'
5796 include 'COMMON.GEO'
5797 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5798 double precision ggg1(3),ggg2(3)
5799 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5804 C /l\ / \ \ / \ / \ / C
5805 C / \ / \ \ / \ / \ / C
5806 C j| o |l1 | o | o| o | | o |o C
5807 C \ |/k\| |/ \| / |/ \| |/ \| C
5808 C \i/ \ / \ / / \ / \ C
5810 C (I) (II) (III) (IV) C
5812 C eello5_1 eello5_2 eello5_3 eello5_4 C
5814 C Antiparallel chains C
5817 C /j\ / \ \ / \ / \ / C
5818 C / \ / \ \ / \ / \ / C
5819 C j1| o |l | o | o| o | | o |o C
5820 C \ |/k\| |/ \| / |/ \| |/ \| C
5821 C \i/ \ / \ / / \ / \ C
5823 C (I) (II) (III) (IV) C
5825 C eello5_1 eello5_2 eello5_3 eello5_4 C
5827 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5829 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5830 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5835 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5837 itk=itortyp(itype(k))
5838 itl=itortyp(itype(l))
5839 itj=itortyp(itype(j))
5844 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5845 cd & eel5_3_num,eel5_4_num)
5849 derx(lll,kkk,iii)=0.0d0
5853 cd eij=facont_hb(jj,i)
5854 cd ekl=facont_hb(kk,k)
5856 cd write (iout,*)'Contacts have occurred for peptide groups',
5857 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5859 C Contribution from the graph I.
5860 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5861 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5862 call transpose2(EUg(1,1,k),auxmat(1,1))
5863 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5864 vv(1)=pizda(1,1)-pizda(2,2)
5865 vv(2)=pizda(1,2)+pizda(2,1)
5866 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5867 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5868 C Explicit gradient in virtual-dihedral angles.
5869 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5870 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5871 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5872 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5873 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5874 vv(1)=pizda(1,1)-pizda(2,2)
5875 vv(2)=pizda(1,2)+pizda(2,1)
5876 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5877 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5878 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5879 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5880 vv(1)=pizda(1,1)-pizda(2,2)
5881 vv(2)=pizda(1,2)+pizda(2,1)
5883 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5884 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5885 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5887 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5888 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5889 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5891 C Cartesian gradient
5895 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5897 vv(1)=pizda(1,1)-pizda(2,2)
5898 vv(2)=pizda(1,2)+pizda(2,1)
5899 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5900 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5901 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5907 C Contribution from graph II
5908 call transpose2(EE(1,1,itk),auxmat(1,1))
5909 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5910 vv(1)=pizda(1,1)+pizda(2,2)
5911 vv(2)=pizda(2,1)-pizda(1,2)
5912 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5913 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5914 C Explicit gradient in virtual-dihedral angles.
5915 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5916 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5917 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5918 vv(1)=pizda(1,1)+pizda(2,2)
5919 vv(2)=pizda(2,1)-pizda(1,2)
5921 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5922 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5923 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5925 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5926 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5927 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5929 C Cartesian gradient
5933 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5935 vv(1)=pizda(1,1)+pizda(2,2)
5936 vv(2)=pizda(2,1)-pizda(1,2)
5937 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5938 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5939 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5947 C Parallel orientation
5948 C Contribution from graph III
5949 call transpose2(EUg(1,1,l),auxmat(1,1))
5950 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5951 vv(1)=pizda(1,1)-pizda(2,2)
5952 vv(2)=pizda(1,2)+pizda(2,1)
5953 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5954 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5955 C Explicit gradient in virtual-dihedral angles.
5956 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5957 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5958 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5959 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5960 vv(1)=pizda(1,1)-pizda(2,2)
5961 vv(2)=pizda(1,2)+pizda(2,1)
5962 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5963 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5964 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5965 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5966 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5967 vv(1)=pizda(1,1)-pizda(2,2)
5968 vv(2)=pizda(1,2)+pizda(2,1)
5969 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5970 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5971 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5972 C Cartesian gradient
5976 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5978 vv(1)=pizda(1,1)-pizda(2,2)
5979 vv(2)=pizda(1,2)+pizda(2,1)
5980 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5981 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5982 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5987 C Contribution from graph IV
5989 call transpose2(EE(1,1,itl),auxmat(1,1))
5990 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5991 vv(1)=pizda(1,1)+pizda(2,2)
5992 vv(2)=pizda(2,1)-pizda(1,2)
5993 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5994 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5995 C Explicit gradient in virtual-dihedral angles.
5996 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5997 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5998 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5999 vv(1)=pizda(1,1)+pizda(2,2)
6000 vv(2)=pizda(2,1)-pizda(1,2)
6001 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6002 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6003 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6004 C Cartesian gradient
6008 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6010 vv(1)=pizda(1,1)+pizda(2,2)
6011 vv(2)=pizda(2,1)-pizda(1,2)
6012 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6013 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6014 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6019 C Antiparallel orientation
6020 C Contribution from graph III
6022 call transpose2(EUg(1,1,j),auxmat(1,1))
6023 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6024 vv(1)=pizda(1,1)-pizda(2,2)
6025 vv(2)=pizda(1,2)+pizda(2,1)
6026 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6027 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6028 C Explicit gradient in virtual-dihedral angles.
6029 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6030 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6031 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6032 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6033 vv(1)=pizda(1,1)-pizda(2,2)
6034 vv(2)=pizda(1,2)+pizda(2,1)
6035 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6036 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6037 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6038 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6039 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6040 vv(1)=pizda(1,1)-pizda(2,2)
6041 vv(2)=pizda(1,2)+pizda(2,1)
6042 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6043 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6044 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6045 C Cartesian gradient
6049 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6051 vv(1)=pizda(1,1)-pizda(2,2)
6052 vv(2)=pizda(1,2)+pizda(2,1)
6053 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6054 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6055 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6060 C Contribution from graph IV
6062 call transpose2(EE(1,1,itj),auxmat(1,1))
6063 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6064 vv(1)=pizda(1,1)+pizda(2,2)
6065 vv(2)=pizda(2,1)-pizda(1,2)
6066 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6067 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6068 C Explicit gradient in virtual-dihedral angles.
6069 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6070 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6071 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6072 vv(1)=pizda(1,1)+pizda(2,2)
6073 vv(2)=pizda(2,1)-pizda(1,2)
6074 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6075 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6076 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6077 C Cartesian gradient
6081 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6083 vv(1)=pizda(1,1)+pizda(2,2)
6084 vv(2)=pizda(2,1)-pizda(1,2)
6085 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6086 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6087 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6093 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6094 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6095 cd write (2,*) 'ijkl',i,j,k,l
6096 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6097 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6099 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6100 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6101 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6102 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6103 if (j.lt.nres-1) then
6110 if (l.lt.nres-1) then
6120 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6122 ggg1(ll)=eel5*g_contij(ll,1)
6123 ggg2(ll)=eel5*g_contij(ll,2)
6124 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6125 ghalf=0.5d0*ggg1(ll)
6127 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6128 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6129 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6130 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6131 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6132 ghalf=0.5d0*ggg2(ll)
6134 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6135 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6136 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6137 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6142 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6143 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6148 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6149 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6155 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6160 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6164 cd write (2,*) iii,g_corr5_loc(iii)
6167 cd write (2,*) 'ekont',ekont
6168 cd write (iout,*) 'eello5',ekont*eel5
6171 c--------------------------------------------------------------------------
6172 double precision function eello6(i,j,k,l,jj,kk)
6173 implicit real*8 (a-h,o-z)
6174 include 'DIMENSIONS'
6175 include 'COMMON.IOUNITS'
6176 include 'COMMON.CHAIN'
6177 include 'COMMON.DERIV'
6178 include 'COMMON.INTERACT'
6179 include 'COMMON.CONTACTS'
6180 include 'COMMON.TORSION'
6181 include 'COMMON.VAR'
6182 include 'COMMON.GEO'
6183 include 'COMMON.FFIELD'
6184 double precision ggg1(3),ggg2(3)
6185 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6190 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6198 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6199 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6203 derx(lll,kkk,iii)=0.0d0
6207 cd eij=facont_hb(jj,i)
6208 cd ekl=facont_hb(kk,k)
6214 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6215 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6216 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6217 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6218 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6219 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6221 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6222 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6223 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6224 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6225 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6226 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6230 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6232 C If turn contributions are considered, they will be handled separately.
6233 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6234 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6235 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6236 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6237 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6238 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6239 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6241 if (j.lt.nres-1) then
6248 if (l.lt.nres-1) then
6256 ggg1(ll)=eel6*g_contij(ll,1)
6257 ggg2(ll)=eel6*g_contij(ll,2)
6258 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6259 ghalf=0.5d0*ggg1(ll)
6261 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6262 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6263 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6264 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6265 ghalf=0.5d0*ggg2(ll)
6266 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6268 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6269 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6270 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6271 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6276 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6277 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6282 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6283 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6289 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6294 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6298 cd write (2,*) iii,g_corr6_loc(iii)
6301 cd write (2,*) 'ekont',ekont
6302 cd write (iout,*) 'eello6',ekont*eel6
6305 c--------------------------------------------------------------------------
6306 double precision function eello6_graph1(i,j,k,l,imat,swap)
6307 implicit real*8 (a-h,o-z)
6308 include 'DIMENSIONS'
6309 include 'COMMON.IOUNITS'
6310 include 'COMMON.CHAIN'
6311 include 'COMMON.DERIV'
6312 include 'COMMON.INTERACT'
6313 include 'COMMON.CONTACTS'
6314 include 'COMMON.TORSION'
6315 include 'COMMON.VAR'
6316 include 'COMMON.GEO'
6317 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6321 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6323 C Parallel Antiparallel
6329 C \ j|/k\| / \ |/k\|l /
6334 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6335 itk=itortyp(itype(k))
6336 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6337 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6338 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6339 call transpose2(EUgC(1,1,k),auxmat(1,1))
6340 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6341 vv1(1)=pizda1(1,1)-pizda1(2,2)
6342 vv1(2)=pizda1(1,2)+pizda1(2,1)
6343 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6344 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6345 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6346 s5=scalar2(vv(1),Dtobr2(1,i))
6347 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6348 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6349 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6350 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6351 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6352 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6353 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6354 & +scalar2(vv(1),Dtobr2der(1,i)))
6355 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6356 vv1(1)=pizda1(1,1)-pizda1(2,2)
6357 vv1(2)=pizda1(1,2)+pizda1(2,1)
6358 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6359 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6361 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6362 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6363 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6364 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6365 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6367 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6368 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6369 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6370 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6371 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6373 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6374 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6375 vv1(1)=pizda1(1,1)-pizda1(2,2)
6376 vv1(2)=pizda1(1,2)+pizda1(2,1)
6377 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6378 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6379 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6380 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6389 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6390 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6391 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6392 call transpose2(EUgC(1,1,k),auxmat(1,1))
6393 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6395 vv1(1)=pizda1(1,1)-pizda1(2,2)
6396 vv1(2)=pizda1(1,2)+pizda1(2,1)
6397 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6398 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6399 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6400 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6401 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6402 s5=scalar2(vv(1),Dtobr2(1,i))
6403 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6409 c----------------------------------------------------------------------------
6410 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6411 implicit real*8 (a-h,o-z)
6412 include 'DIMENSIONS'
6413 include 'COMMON.IOUNITS'
6414 include 'COMMON.CHAIN'
6415 include 'COMMON.DERIV'
6416 include 'COMMON.INTERACT'
6417 include 'COMMON.CONTACTS'
6418 include 'COMMON.TORSION'
6419 include 'COMMON.VAR'
6420 include 'COMMON.GEO'
6422 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6423 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6426 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6428 C Parallel Antiparallel
6439 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6440 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6441 C AL 7/4/01 s1 would occur in the sixth-order moment,
6442 C but not in a cluster cumulant
6444 s1=dip(1,jj,i)*dip(1,kk,k)
6446 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6447 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6448 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6449 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6450 call transpose2(EUg(1,1,k),auxmat(1,1))
6451 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6452 vv(1)=pizda(1,1)-pizda(2,2)
6453 vv(2)=pizda(1,2)+pizda(2,1)
6454 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6455 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6457 eello6_graph2=-(s1+s2+s3+s4)
6459 eello6_graph2=-(s2+s3+s4)
6462 C Derivatives in gamma(i-1)
6465 s1=dipderg(1,jj,i)*dip(1,kk,k)
6467 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6468 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6469 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6470 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6472 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6474 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6476 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6478 C Derivatives in gamma(k-1)
6480 s1=dip(1,jj,i)*dipderg(1,kk,k)
6482 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6483 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6484 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6485 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6486 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6487 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6488 vv(1)=pizda(1,1)-pizda(2,2)
6489 vv(2)=pizda(1,2)+pizda(2,1)
6490 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6492 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6494 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6496 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6497 C Derivatives in gamma(j-1) or gamma(l-1)
6500 s1=dipderg(3,jj,i)*dip(1,kk,k)
6502 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6503 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6504 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6505 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6506 vv(1)=pizda(1,1)-pizda(2,2)
6507 vv(2)=pizda(1,2)+pizda(2,1)
6508 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6511 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6513 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6516 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6517 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6519 C Derivatives in gamma(l-1) or gamma(j-1)
6522 s1=dip(1,jj,i)*dipderg(3,kk,k)
6524 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6525 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6526 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6527 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6528 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6529 vv(1)=pizda(1,1)-pizda(2,2)
6530 vv(2)=pizda(1,2)+pizda(2,1)
6531 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6534 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6536 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6539 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6540 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6542 C Cartesian derivatives.
6544 write (2,*) 'In eello6_graph2'
6546 write (2,*) 'iii=',iii
6548 write (2,*) 'kkk=',kkk
6550 write (2,'(3(2f10.5),5x)')
6551 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6561 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6563 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6566 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6568 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6569 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6571 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6572 call transpose2(EUg(1,1,k),auxmat(1,1))
6573 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6575 vv(1)=pizda(1,1)-pizda(2,2)
6576 vv(2)=pizda(1,2)+pizda(2,1)
6577 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6578 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6580 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6582 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6585 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6587 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6594 c----------------------------------------------------------------------------
6595 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6596 implicit real*8 (a-h,o-z)
6597 include 'DIMENSIONS'
6598 include 'COMMON.IOUNITS'
6599 include 'COMMON.CHAIN'
6600 include 'COMMON.DERIV'
6601 include 'COMMON.INTERACT'
6602 include 'COMMON.CONTACTS'
6603 include 'COMMON.TORSION'
6604 include 'COMMON.VAR'
6605 include 'COMMON.GEO'
6606 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6608 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6610 C Parallel Antiparallel
6621 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6623 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6624 C energy moment and not to the cluster cumulant.
6625 iti=itortyp(itype(i))
6626 if (j.lt.nres-1) then
6627 itj1=itortyp(itype(j+1))
6631 itk=itortyp(itype(k))
6632 itk1=itortyp(itype(k+1))
6633 if (l.lt.nres-1) then
6634 itl1=itortyp(itype(l+1))
6639 s1=dip(4,jj,i)*dip(4,kk,k)
6641 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6642 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6643 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6644 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6645 call transpose2(EE(1,1,itk),auxmat(1,1))
6646 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6647 vv(1)=pizda(1,1)+pizda(2,2)
6648 vv(2)=pizda(2,1)-pizda(1,2)
6649 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6650 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6652 eello6_graph3=-(s1+s2+s3+s4)
6654 eello6_graph3=-(s2+s3+s4)
6657 C Derivatives in gamma(k-1)
6658 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6659 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6660 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6661 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6662 C Derivatives in gamma(l-1)
6663 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6664 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6665 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6666 vv(1)=pizda(1,1)+pizda(2,2)
6667 vv(2)=pizda(2,1)-pizda(1,2)
6668 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6669 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6670 C Cartesian derivatives.
6676 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6678 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6681 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6683 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6684 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6686 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6687 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6689 vv(1)=pizda(1,1)+pizda(2,2)
6690 vv(2)=pizda(2,1)-pizda(1,2)
6691 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6693 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6695 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6698 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6700 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6702 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6708 c----------------------------------------------------------------------------
6709 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6710 implicit real*8 (a-h,o-z)
6711 include 'DIMENSIONS'
6712 include 'COMMON.IOUNITS'
6713 include 'COMMON.CHAIN'
6714 include 'COMMON.DERIV'
6715 include 'COMMON.INTERACT'
6716 include 'COMMON.CONTACTS'
6717 include 'COMMON.TORSION'
6718 include 'COMMON.VAR'
6719 include 'COMMON.GEO'
6720 include 'COMMON.FFIELD'
6721 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6722 & auxvec1(2),auxmat1(2,2)
6724 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6726 C Parallel Antiparallel
6737 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6739 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6740 C energy moment and not to the cluster cumulant.
6741 cd write (2,*) 'eello_graph4: wturn6',wturn6
6742 iti=itortyp(itype(i))
6743 itj=itortyp(itype(j))
6744 if (j.lt.nres-1) then
6745 itj1=itortyp(itype(j+1))
6749 itk=itortyp(itype(k))
6750 if (k.lt.nres-1) then
6751 itk1=itortyp(itype(k+1))
6755 itl=itortyp(itype(l))
6756 if (l.lt.nres-1) then
6757 itl1=itortyp(itype(l+1))
6761 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6762 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6763 cd & ' itl',itl,' itl1',itl1
6766 s1=dip(3,jj,i)*dip(3,kk,k)
6768 s1=dip(2,jj,j)*dip(2,kk,l)
6771 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6772 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6774 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6775 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6777 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6778 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6780 call transpose2(EUg(1,1,k),auxmat(1,1))
6781 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6782 vv(1)=pizda(1,1)-pizda(2,2)
6783 vv(2)=pizda(2,1)+pizda(1,2)
6784 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6785 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6787 eello6_graph4=-(s1+s2+s3+s4)
6789 eello6_graph4=-(s2+s3+s4)
6791 C Derivatives in gamma(i-1)
6795 s1=dipderg(2,jj,i)*dip(3,kk,k)
6797 s1=dipderg(4,jj,j)*dip(2,kk,l)
6800 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6802 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6803 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6805 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6806 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6808 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6809 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6810 cd write (2,*) 'turn6 derivatives'
6812 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6814 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6818 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6820 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6824 C Derivatives in gamma(k-1)
6827 s1=dip(3,jj,i)*dipderg(2,kk,k)
6829 s1=dip(2,jj,j)*dipderg(4,kk,l)
6832 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6833 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6835 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6836 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6838 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6839 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6841 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6842 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6843 vv(1)=pizda(1,1)-pizda(2,2)
6844 vv(2)=pizda(2,1)+pizda(1,2)
6845 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6846 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6848 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6850 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6854 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6856 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6859 C Derivatives in gamma(j-1) or gamma(l-1)
6860 if (l.eq.j+1 .and. l.gt.1) then
6861 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6862 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6863 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6864 vv(1)=pizda(1,1)-pizda(2,2)
6865 vv(2)=pizda(2,1)+pizda(1,2)
6866 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6867 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6868 else if (j.gt.1) then
6869 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6870 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6871 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6872 vv(1)=pizda(1,1)-pizda(2,2)
6873 vv(2)=pizda(2,1)+pizda(1,2)
6874 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6875 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6876 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6878 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6881 C Cartesian derivatives.
6888 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6890 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6894 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6896 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6900 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6902 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6904 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6905 & b1(1,itj1),auxvec(1))
6906 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6908 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6909 & b1(1,itl1),auxvec(1))
6910 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6912 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6914 vv(1)=pizda(1,1)-pizda(2,2)
6915 vv(2)=pizda(2,1)+pizda(1,2)
6916 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6918 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6920 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6923 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6926 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6929 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6931 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6933 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6937 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6939 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6942 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6944 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6952 c----------------------------------------------------------------------------
6953 double precision function eello_turn6(i,jj,kk)
6954 implicit real*8 (a-h,o-z)
6955 include 'DIMENSIONS'
6956 include 'COMMON.IOUNITS'
6957 include 'COMMON.CHAIN'
6958 include 'COMMON.DERIV'
6959 include 'COMMON.INTERACT'
6960 include 'COMMON.CONTACTS'
6961 include 'COMMON.TORSION'
6962 include 'COMMON.VAR'
6963 include 'COMMON.GEO'
6964 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6965 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6967 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6968 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6969 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6970 C the respective energy moment and not to the cluster cumulant.
6979 iti=itortyp(itype(i))
6980 itk=itortyp(itype(k))
6981 itk1=itortyp(itype(k+1))
6982 itl=itortyp(itype(l))
6983 itj=itortyp(itype(j))
6984 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6985 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6986 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6991 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6993 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6997 derx_turn(lll,kkk,iii)=0.0d0
7004 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7006 cd write (2,*) 'eello6_5',eello6_5
7008 call transpose2(AEA(1,1,1),auxmat(1,1))
7009 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7010 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7011 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7013 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7014 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7015 s2 = scalar2(b1(1,itk),vtemp1(1))
7017 call transpose2(AEA(1,1,2),atemp(1,1))
7018 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7019 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7020 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7022 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7023 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7024 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7026 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7027 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7028 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7029 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7030 ss13 = scalar2(b1(1,itk),vtemp4(1))
7031 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7033 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7039 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7040 C Derivatives in gamma(i+2)
7044 call transpose2(AEA(1,1,1),auxmatd(1,1))
7045 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7046 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7047 call transpose2(AEAderg(1,1,2),atempd(1,1))
7048 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7049 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7051 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7052 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7053 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7059 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7060 C Derivatives in gamma(i+3)
7062 call transpose2(AEA(1,1,1),auxmatd(1,1))
7063 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7064 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7065 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7067 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7068 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7069 s2d = scalar2(b1(1,itk),vtemp1d(1))
7071 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7072 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7074 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7076 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7077 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7078 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7086 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7087 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7089 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7090 & -0.5d0*ekont*(s2d+s12d)
7092 C Derivatives in gamma(i+4)
7093 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7094 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7095 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7097 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7098 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7099 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7107 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7109 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7111 C Derivatives in gamma(i+5)
7113 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7114 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7115 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7117 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7118 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7119 s2d = scalar2(b1(1,itk),vtemp1d(1))
7121 call transpose2(AEA(1,1,2),atempd(1,1))
7122 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7123 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7125 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7126 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7128 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7129 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7130 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7138 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7139 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7141 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7142 & -0.5d0*ekont*(s2d+s12d)
7144 C Cartesian derivatives
7149 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7150 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7151 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7153 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7154 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7156 s2d = scalar2(b1(1,itk),vtemp1d(1))
7158 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7159 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7160 s8d = -(atempd(1,1)+atempd(2,2))*
7161 & scalar2(cc(1,1,itl),vtemp2(1))
7163 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7165 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7166 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7173 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7176 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7180 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7181 & - 0.5d0*(s8d+s12d)
7183 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7192 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7194 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7195 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7196 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7197 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7198 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7200 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7201 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7202 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7206 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7207 cd & 16*eel_turn6_num
7209 if (j.lt.nres-1) then
7216 if (l.lt.nres-1) then
7224 ggg1(ll)=eel_turn6*g_contij(ll,1)
7225 ggg2(ll)=eel_turn6*g_contij(ll,2)
7226 ghalf=0.5d0*ggg1(ll)
7228 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7229 & +ekont*derx_turn(ll,2,1)
7230 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7231 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7232 & +ekont*derx_turn(ll,4,1)
7233 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7234 ghalf=0.5d0*ggg2(ll)
7236 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7237 & +ekont*derx_turn(ll,2,2)
7238 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7239 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7240 & +ekont*derx_turn(ll,4,2)
7241 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7246 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7251 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7257 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7262 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7266 cd write (2,*) iii,g_corr6_loc(iii)
7268 eello_turn6=ekont*eel_turn6
7269 cd write (2,*) 'ekont',ekont
7270 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7274 C-----------------------------------------------------------------------------
7275 double precision function scalar(u,v)
7276 !DIR$ INLINEALWAYS scalar
7278 cDEC$ ATTRIBUTES FORCEINLINE::scalar
7281 double precision u(3),v(3)
7282 cd double precision sc
7290 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
7293 crc-------------------------------------------------
7294 SUBROUTINE MATVEC2(A1,V1,V2)
7295 !DIR$ INLINEALWAYS MATVEC2
7297 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
7299 implicit real*8 (a-h,o-z)
7300 include 'DIMENSIONS'
7301 DIMENSION A1(2,2),V1(2),V2(2)
7305 c 3 VI=VI+A1(I,K)*V1(K)
7309 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7310 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7315 C---------------------------------------
7316 SUBROUTINE MATMAT2(A1,A2,A3)
7318 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
7320 implicit real*8 (a-h,o-z)
7321 include 'DIMENSIONS'
7322 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7323 c DIMENSION AI3(2,2)
7327 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7333 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7334 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7335 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7336 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7344 c-------------------------------------------------------------------------
7345 double precision function scalar2(u,v)
7346 !DIR$ INLINEALWAYS scalar2
7348 double precision u(2),v(2)
7351 scalar2=u(1)*v(1)+u(2)*v(2)
7355 C-----------------------------------------------------------------------------
7357 subroutine transpose2(a,at)
7358 !DIR$ INLINEALWAYS transpose2
7360 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
7363 double precision a(2,2),at(2,2)
7370 c--------------------------------------------------------------------------
7371 subroutine transpose(n,a,at)
7374 double precision a(n,n),at(n,n)
7382 C---------------------------------------------------------------------------
7383 subroutine prodmat3(a1,a2,kk,transp,prod)
7384 !DIR$ INLINEALWAYS prodmat3
7386 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
7390 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7392 crc double precision auxmat(2,2),prod_(2,2)
7395 crc call transpose2(kk(1,1),auxmat(1,1))
7396 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7397 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7399 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7400 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7401 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7402 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7403 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7404 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7405 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7406 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7409 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7410 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7412 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7413 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7414 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7415 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7416 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7417 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7418 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7419 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7422 c call transpose2(a2(1,1),a2t(1,1))
7425 crc print *,((prod_(i,j),i=1,2),j=1,2)
7426 crc print *,((prod(i,j),i=1,2),j=1,2)