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 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'
1967 include "COMMON.SETUP"
1969 integer status(MPI_STATUS_SIZE)
1971 include 'COMMON.IOUNITS'
1972 include 'COMMON.GEO'
1973 include 'COMMON.VAR'
1974 include 'COMMON.LOCAL'
1975 include 'COMMON.CHAIN'
1976 include 'COMMON.DERIV'
1977 include 'COMMON.INTERACT'
1978 include 'COMMON.CONTACTS'
1979 include 'COMMON.TORSION'
1980 include 'COMMON.VECTORS'
1981 include 'COMMON.FFIELD'
1982 double precision auxvec(2),auxmat(2,2)
1984 C Compute the virtual-bond-torsional-angle dependent quantities needed
1985 C to calculate the el-loc multibody terms of various order.
1988 do i=ivec_start+2,ivec_end+2
1989 if (i .lt. nres+1) then
2026 if (i .gt. 3 .and. i .lt. nres+1) then
2027 obrot_der(1,i-2)=-sin1
2028 obrot_der(2,i-2)= cos1
2029 Ugder(1,1,i-2)= sin1
2030 Ugder(1,2,i-2)=-cos1
2031 Ugder(2,1,i-2)=-cos1
2032 Ugder(2,2,i-2)=-sin1
2035 obrot2_der(1,i-2)=-dwasin2
2036 obrot2_der(2,i-2)= dwacos2
2037 Ug2der(1,1,i-2)= dwasin2
2038 Ug2der(1,2,i-2)=-dwacos2
2039 Ug2der(2,1,i-2)=-dwacos2
2040 Ug2der(2,2,i-2)=-dwasin2
2042 obrot_der(1,i-2)=0.0d0
2043 obrot_der(2,i-2)=0.0d0
2044 Ugder(1,1,i-2)=0.0d0
2045 Ugder(1,2,i-2)=0.0d0
2046 Ugder(2,1,i-2)=0.0d0
2047 Ugder(2,2,i-2)=0.0d0
2048 obrot2_der(1,i-2)=0.0d0
2049 obrot2_der(2,i-2)=0.0d0
2050 Ug2der(1,1,i-2)=0.0d0
2051 Ug2der(1,2,i-2)=0.0d0
2052 Ug2der(2,1,i-2)=0.0d0
2053 Ug2der(2,2,i-2)=0.0d0
2055 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2056 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2057 iti = itortyp(itype(i-2))
2061 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2062 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2063 iti1 = itortyp(itype(i-1))
2067 cd write (iout,*) '*******i',i,' iti1',iti
2068 cd write (iout,*) 'b1',b1(:,iti)
2069 cd write (iout,*) 'b2',b2(:,iti)
2070 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2071 c if (i .gt. iatel_s+2) then
2072 if (i .gt. nnt+2) then
2073 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2074 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2075 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2077 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2078 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2079 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2080 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2081 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2092 DtUg2(l,k,i-2)=0.0d0
2096 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2097 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2099 muder(k,i-2)=Ub2der(k,i-2)
2101 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2102 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2103 iti1 = itortyp(itype(i-1))
2108 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2110 cd write (iout,*) 'mu ',mu(:,i-2)
2111 cd write (iout,*) 'mu1',mu1(:,i-2)
2112 cd write (iout,*) 'mu2',mu2(:,i-2)
2113 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2115 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2116 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2117 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2118 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2119 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2120 C Vectors and matrices dependent on a single virtual-bond dihedral.
2121 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2122 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2123 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2124 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2125 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2126 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2127 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2128 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2129 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2132 C Matrices dependent on two consecutive virtual-bond dihedrals.
2133 C The order of matrices is from left to right.
2134 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2136 do i=ivec_start,ivec_end
2138 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2139 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2140 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2141 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2142 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2143 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2144 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2145 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2150 c if (fg_rank.eq.0) then
2151 write (iout,*) "Arrays UG and UGDER before GATHER"
2153 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2154 & ((ug(l,k,i),l=1,2),k=1,2),
2155 & ((ugder(l,k,i),l=1,2),k=1,2)
2157 write (iout,*) "Arrays UG2 and UG2DER"
2159 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2160 & ((ug2(l,k,i),l=1,2),k=1,2),
2161 & ((ug2der(l,k,i),l=1,2),k=1,2)
2163 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2165 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2166 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2167 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2169 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2171 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2172 & costab(i),sintab(i),costab2(i),sintab2(i)
2174 write (iout,*) "Array MUDER"
2176 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2180 if (nfgtasks.gt.1) then
2182 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2183 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2184 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2186 write (iout,*) "MPI_ROTAT",MPI_ROTAT
2187 c call MPI_Allgatherv(ug(1,1,ivec_start),ivec_count(fg_rank),
2188 c & MPI_MAT1,ug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2190 c call MPI_Allgatherv(ugder(1,1,ivec_start),ivec_count(fg_rank),
2191 c & MPI_MAT1,ugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2193 c call MPI_Allgatherv(ug2(1,1,ivec_start),ivec_count(fg_rank),
2194 c & MPI_MAT1,ug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2196 c call MPI_Allgatherv(ug2der(1,1,ivec_start),ivec_count(fg_rank),
2197 c & MPI_MAT1,ug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2199 c call MPI_Allgatherv(obrot(1,ivec_start),ivec_count(fg_rank),
2200 c & MPI_MU,obrot(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2202 c call MPI_Allgatherv(obrot2(1,ivec_start),ivec_count(fg_rank),
2203 c & MPI_MU,obrot2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2205 c call MPI_Allgatherv(obrot_der(1,ivec_start),ivec_count(fg_rank),
2206 c & MPI_MU,obrot_der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2208 c call MPI_Allgatherv(obrot2_der(1,ivec_start),
2209 c & ivec_count(fg_rank),
2210 c & MPI_MU,obrot2_der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2212 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank),
2213 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2215 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank),
2216 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2218 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank),
2219 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2221 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank),
2222 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2224 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank),
2225 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2227 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank),
2228 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2230 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank),
2231 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2232 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2233 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank),
2234 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2235 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2236 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank),
2237 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2238 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2239 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank),
2240 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2241 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2242 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2244 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank),
2245 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2247 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank),
2248 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2250 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank),
2251 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2253 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank),
2254 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2256 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank),
2257 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2259 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2260 & ivec_count(fg_rank),
2261 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2263 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank),
2264 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2266 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank),
2267 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2269 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank),
2270 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2272 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank),
2273 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2275 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank),
2276 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2278 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank),
2279 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2281 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank),
2282 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2284 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2285 & ivec_count(fg_rank),
2286 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2288 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank),
2289 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2291 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank),
2292 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2294 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank),
2295 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2297 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank),
2298 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2300 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2301 & ivec_count(fg_rank),
2302 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2304 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2305 & ivec_count(fg_rank),
2306 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2308 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2309 & ivec_count(fg_rank),
2310 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2311 & MPI_MAT2,FG_COMM,IERR)
2312 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2313 & ivec_count(fg_rank),
2314 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2315 & MPI_MAT2,FG_COMM,IERR)
2318 c Passes matrix info through the ring
2321 if (irecv.lt.0) irecv=nfgtasks-1
2324 if (inext.ge.nfgtasks) inext=0
2326 c write (iout,*) "isend",isend," irecv",irecv
2328 lensend=lentyp(isend)
2329 lenrecv=lentyp(irecv)
2330 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2331 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2332 c & MPI_ROTAT1(lensend),inext,2200+isend,
2333 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2334 c & iprev,2200+irecv,FG_COMM,status,IERR)
2335 c write (iout,*) "Gather ROTAT1"
2337 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2338 c & MPI_ROTAT2(lensend),inext,3300+isend,
2339 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2340 c & iprev,3300+irecv,FG_COMM,status,IERR)
2341 c write (iout,*) "Gather ROTAT2"
2343 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2344 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2345 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2346 & iprev,4400+irecv,FG_COMM,status,IERR)
2347 c write (iout,*) "Gather ROTAT_OLD"
2349 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2350 & MPI_PRECOMP11(lensend),inext,5500+isend,
2351 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2352 & iprev,5500+irecv,FG_COMM,status,IERR)
2353 c write (iout,*) "Gather PRECOMP11"
2355 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2356 & MPI_PRECOMP12(lensend),inext,6600+isend,
2357 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2358 & iprev,6600+irecv,FG_COMM,status,IERR)
2359 c write (iout,*) "Gather PRECOMP12"
2361 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2363 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2364 & MPI_ROTAT2(lensend),inext,7700+isend,
2365 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2366 & iprev,7700+irecv,FG_COMM,status,IERR)
2367 c write (iout,*) "Gather PRECOMP21"
2369 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2370 & MPI_PRECOMP22(lensend),inext,8800+isend,
2371 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2372 & iprev,8800+irecv,FG_COMM,status,IERR)
2373 c write (iout,*) "Gather PRECOMP22"
2375 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2376 & MPI_PRECOMP23(lensend),inext,9900+isend,
2377 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2378 & MPI_PRECOMP23(lenrecv),
2379 & iprev,9900+irecv,FG_COMM,status,IERR)
2380 c write (iout,*) "Gather PRECOMP23"
2385 if (irecv.lt.0) irecv=nfgtasks-1
2388 time_gather=time_gather+MPI_Wtime()-time00
2391 c if (fg_rank.eq.0) then
2392 write (iout,*) "Arrays UG and UGDER"
2394 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2395 & ((ug(l,k,i),l=1,2),k=1,2),
2396 & ((ugder(l,k,i),l=1,2),k=1,2)
2398 write (iout,*) "Arrays UG2 and UG2DER"
2400 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2401 & ((ug2(l,k,i),l=1,2),k=1,2),
2402 & ((ug2der(l,k,i),l=1,2),k=1,2)
2404 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2406 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2407 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2408 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2410 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2412 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2413 & costab(i),sintab(i),costab2(i),sintab2(i)
2415 write (iout,*) "Array MUDER"
2417 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2423 cd iti = itortyp(itype(i))
2426 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2427 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2432 C--------------------------------------------------------------------------
2433 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2435 C This subroutine calculates the average interaction energy and its gradient
2436 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2437 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2438 C The potential depends both on the distance of peptide-group centers and on
2439 C the orientation of the CA-CA virtual bonds.
2441 implicit real*8 (a-h,o-z)
2442 include 'DIMENSIONS'
2443 include 'COMMON.CONTROL'
2444 include 'COMMON.IOUNITS'
2445 include 'COMMON.GEO'
2446 include 'COMMON.VAR'
2447 include 'COMMON.LOCAL'
2448 include 'COMMON.CHAIN'
2449 include 'COMMON.DERIV'
2450 include 'COMMON.INTERACT'
2451 include 'COMMON.CONTACTS'
2452 include 'COMMON.TORSION'
2453 include 'COMMON.VECTORS'
2454 include 'COMMON.FFIELD'
2455 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2456 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2457 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2458 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2459 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2460 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2462 double precision scal_el /1.0d0/
2464 double precision scal_el /0.5d0/
2467 C 13-go grudnia roku pamietnego...
2468 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2469 & 0.0d0,1.0d0,0.0d0,
2470 & 0.0d0,0.0d0,1.0d0/
2471 cd write(iout,*) 'In EELEC'
2473 cd write(iout,*) 'Type',i
2474 cd write(iout,*) 'B1',B1(:,i)
2475 cd write(iout,*) 'B2',B2(:,i)
2476 cd write(iout,*) 'CC',CC(:,:,i)
2477 cd write(iout,*) 'DD',DD(:,:,i)
2478 cd write(iout,*) 'EE',EE(:,:,i)
2480 cd call check_vecgrad
2482 if (icheckgrad.eq.1) then
2484 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2486 dc_norm(k,i)=dc(k,i)*fac
2488 c write (iout,*) 'i',i,' fac',fac
2491 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2492 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2493 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2494 c call vec_and_deriv
2498 cd write (iout,*) 'i=',i
2500 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2503 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2504 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2517 cd print '(a)','Enter EELEC'
2518 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2520 gel_loc_loc(i)=0.0d0
2523 do i=iatel_s,iatel_e
2527 dx_normi=dc_norm(1,i)
2528 dy_normi=dc_norm(2,i)
2529 dz_normi=dc_norm(3,i)
2530 xmedi=c(1,i)+0.5d0*dxi
2531 ymedi=c(2,i)+0.5d0*dyi
2532 zmedi=c(3,i)+0.5d0*dzi
2534 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2535 do j=ielstart(i),ielend(i)
2539 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2540 aaa=app(iteli,itelj)
2541 bbb=bpp(iteli,itelj)
2542 ael6i=ael6(iteli,itelj)
2543 ael3i=ael3(iteli,itelj)
2544 C Diagnostics only!!!
2553 dx_normj=dc_norm(1,j)
2554 dy_normj=dc_norm(2,j)
2555 dz_normj=dc_norm(3,j)
2556 xj=c(1,j)+0.5D0*dxj-xmedi
2557 yj=c(2,j)+0.5D0*dyj-ymedi
2558 zj=c(3,j)+0.5D0*dzj-zmedi
2559 rij=xj*xj+yj*yj+zj*zj
2565 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2566 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2567 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2568 fac=cosa-3.0D0*cosb*cosg
2570 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2571 if (j.eq.i+2) ev1=scal_el*ev1
2576 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2579 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2580 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2583 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2584 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2585 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2586 cd & xmedi,ymedi,zmedi,xj,yj,zj
2588 if (energy_dec) then
2589 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2590 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2594 C Calculate contributions to the Cartesian gradient.
2597 facvdw=-6*rrmij*(ev1+evdwij)
2598 facel=-3*rrmij*(el1+eesij)
2604 * Radial derivatives. First process both termini of the fragment (i,j)
2611 gelc(k,i)=gelc(k,i)+ghalf
2612 gelc(k,j)=gelc(k,j)+ghalf
2615 * Loop over residues i+1 thru j-1.
2619 gelc(l,k)=gelc(l,k)+ggg(l)
2627 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2628 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2631 * Loop over residues i+1 thru j-1.
2635 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2642 fac=-3*rrmij*(facvdw+facvdw+facel)
2647 * Radial derivatives. First process both termini of the fragment (i,j)
2654 gelc(k,i)=gelc(k,i)+ghalf
2655 gelc(k,j)=gelc(k,j)+ghalf
2658 * Loop over residues i+1 thru j-1.
2662 gelc(l,k)=gelc(l,k)+ggg(l)
2669 ecosa=2.0D0*fac3*fac1+fac4
2672 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2673 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2675 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2676 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2678 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2679 cd & (dcosg(k),k=1,3)
2681 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2685 gelc(k,i)=gelc(k,i)+ghalf
2686 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2687 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2688 gelc(k,j)=gelc(k,j)+ghalf
2689 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2690 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2694 gelc(l,k)=gelc(l,k)+ggg(l)
2698 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2699 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2700 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2702 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2703 C energy of a peptide unit is assumed in the form of a second-order
2704 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2705 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2706 C are computed for EVERY pair of non-contiguous peptide groups.
2708 if (j.lt.nres-1) then
2719 muij(kkk)=mu(k,i)*mu(l,j)
2722 cd write (iout,*) 'EELEC: i',i,' j',j
2723 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2724 cd write(iout,*) 'muij',muij
2725 ury=scalar(uy(1,i),erij)
2726 urz=scalar(uz(1,i),erij)
2727 vry=scalar(uy(1,j),erij)
2728 vrz=scalar(uz(1,j),erij)
2729 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2730 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2731 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2732 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2733 C For diagnostics only
2738 fac=dsqrt(-ael6i)*r3ij
2739 cd write (2,*) 'fac=',fac
2740 C For diagnostics only
2746 cd write (iout,'(4i5,4f10.5)')
2747 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2748 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2749 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2750 cd & uy(:,j),uz(:,j)
2751 cd write (iout,'(4f10.5)')
2752 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2753 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2754 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2755 cd write (iout,'(9f10.5/)')
2756 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2757 C Derivatives of the elements of A in virtual-bond vectors
2758 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2765 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2766 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2767 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2768 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2769 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2770 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2771 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2772 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2773 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2774 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2775 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2776 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2786 C Compute radial contributions to the gradient
2808 C Add the contributions coming from er
2811 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2812 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2813 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2814 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2817 C Derivatives in DC(i)
2818 ghalf1=0.5d0*agg(k,1)
2819 ghalf2=0.5d0*agg(k,2)
2820 ghalf3=0.5d0*agg(k,3)
2821 ghalf4=0.5d0*agg(k,4)
2822 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2823 & -3.0d0*uryg(k,2)*vry)+ghalf1
2824 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2825 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2826 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2827 & -3.0d0*urzg(k,2)*vry)+ghalf3
2828 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2829 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2830 C Derivatives in DC(i+1)
2831 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2832 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2833 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2834 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2835 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2836 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2837 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2838 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2839 C Derivatives in DC(j)
2840 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2841 & -3.0d0*vryg(k,2)*ury)+ghalf1
2842 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2843 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2844 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2845 & -3.0d0*vryg(k,2)*urz)+ghalf3
2846 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2847 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2848 C Derivatives in DC(j+1) or DC(nres-1)
2849 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2850 & -3.0d0*vryg(k,3)*ury)
2851 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2852 & -3.0d0*vrzg(k,3)*ury)
2853 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2854 & -3.0d0*vryg(k,3)*urz)
2855 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2856 & -3.0d0*vrzg(k,3)*urz)
2861 C Derivatives in DC(i+1)
2862 cd aggi1(k,1)=agg(k,1)
2863 cd aggi1(k,2)=agg(k,2)
2864 cd aggi1(k,3)=agg(k,3)
2865 cd aggi1(k,4)=agg(k,4)
2866 C Derivatives in DC(j)
2871 C Derivatives in DC(j+1)
2876 if (j.eq.nres-1 .and. i.lt.j-2) then
2878 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2879 cd aggj1(k,l)=agg(k,l)
2884 C Check the loc-el terms by numerical integration
2894 aggi(k,l)=-aggi(k,l)
2895 aggi1(k,l)=-aggi1(k,l)
2896 aggj(k,l)=-aggj(k,l)
2897 aggj1(k,l)=-aggj1(k,l)
2900 if (j.lt.nres-1) then
2906 aggi(k,l)=-aggi(k,l)
2907 aggi1(k,l)=-aggi1(k,l)
2908 aggj(k,l)=-aggj(k,l)
2909 aggj1(k,l)=-aggj1(k,l)
2920 aggi(k,l)=-aggi(k,l)
2921 aggi1(k,l)=-aggi1(k,l)
2922 aggj(k,l)=-aggj(k,l)
2923 aggj1(k,l)=-aggj1(k,l)
2929 IF (wel_loc.gt.0.0d0) THEN
2930 C Contribution to the local-electrostatic energy coming from the i-j pair
2931 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2933 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2935 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2936 & 'eelloc',i,j,eel_loc_ij
2938 eel_loc=eel_loc+eel_loc_ij
2939 C Partial derivatives in virtual-bond dihedral angles gamma
2941 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2942 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2943 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2944 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2945 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2946 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2947 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2948 cd write(iout,*) 'agg ',agg
2949 cd write(iout,*) 'aggi ',aggi
2950 cd write(iout,*) 'aggi1',aggi1
2951 cd write(iout,*) 'aggj ',aggj
2952 cd write(iout,*) 'aggj1',aggj1
2954 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2956 ggg(l)=agg(l,1)*muij(1)+
2957 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2961 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2964 C Remaining derivatives of eello
2966 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2967 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2968 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2969 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2970 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2971 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2972 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2973 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2976 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2977 C Contributions from turns
2982 call eturn34(i,j,eello_turn3,eello_turn4)
2984 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2985 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2987 C Calculate the contact function. The ith column of the array JCONT will
2988 C contain the numbers of atoms that make contacts with the atom I (of numbers
2989 C greater than I). The arrays FACONT and GACONT will contain the values of
2990 C the contact function and its derivative.
2991 c r0ij=1.02D0*rpp(iteli,itelj)
2992 c r0ij=1.11D0*rpp(iteli,itelj)
2993 r0ij=2.20D0*rpp(iteli,itelj)
2994 c r0ij=1.55D0*rpp(iteli,itelj)
2995 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2996 if (fcont.gt.0.0D0) then
2997 num_conti=num_conti+1
2998 if (num_conti.gt.maxconts) then
2999 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3000 & ' will skip next contacts for this conf.'
3002 jcont_hb(num_conti,i)=j
3003 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3004 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3005 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3007 d_cont(num_conti,i)=rij
3008 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3009 C --- Electrostatic-interaction matrix ---
3010 a_chuj(1,1,num_conti,i)=a22
3011 a_chuj(1,2,num_conti,i)=a23
3012 a_chuj(2,1,num_conti,i)=a32
3013 a_chuj(2,2,num_conti,i)=a33
3014 C --- Gradient of rij
3016 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3019 c a_chuj(1,1,num_conti,i)=-0.61d0
3020 c a_chuj(1,2,num_conti,i)= 0.4d0
3021 c a_chuj(2,1,num_conti,i)= 0.65d0
3022 c a_chuj(2,2,num_conti,i)= 0.50d0
3023 c else if (i.eq.2) then
3024 c a_chuj(1,1,num_conti,i)= 0.0d0
3025 c a_chuj(1,2,num_conti,i)= 0.0d0
3026 c a_chuj(2,1,num_conti,i)= 0.0d0
3027 c a_chuj(2,2,num_conti,i)= 0.0d0
3029 C --- and its gradients
3030 cd write (iout,*) 'i',i,' j',j
3032 cd write (iout,*) 'iii 1 kkk',kkk
3033 cd write (iout,*) agg(kkk,:)
3036 cd write (iout,*) 'iii 2 kkk',kkk
3037 cd write (iout,*) aggi(kkk,:)
3040 cd write (iout,*) 'iii 3 kkk',kkk
3041 cd write (iout,*) aggi1(kkk,:)
3044 cd write (iout,*) 'iii 4 kkk',kkk
3045 cd write (iout,*) aggj(kkk,:)
3048 cd write (iout,*) 'iii 5 kkk',kkk
3049 cd write (iout,*) aggj1(kkk,:)
3056 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3057 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3058 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3059 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3060 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3062 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
3068 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3069 C Calculate contact energies
3071 wij=cosa-3.0D0*cosb*cosg
3074 c fac3=dsqrt(-ael6i)/r0ij**3
3075 fac3=dsqrt(-ael6i)*r3ij
3076 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3077 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3078 if (ees0tmp.gt.0) then
3079 ees0pij=dsqrt(ees0tmp)
3083 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3084 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3085 if (ees0tmp.gt.0) then
3086 ees0mij=dsqrt(ees0tmp)
3091 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3092 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3093 C Diagnostics. Comment out or remove after debugging!
3094 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3095 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3096 c ees0m(num_conti,i)=0.0D0
3098 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3099 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3100 C Angular derivatives of the contact function
3101 ees0pij1=fac3/ees0pij
3102 ees0mij1=fac3/ees0mij
3103 fac3p=-3.0D0*fac3*rrmij
3104 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3105 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3107 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3108 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3109 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3110 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3111 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3112 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3113 ecosap=ecosa1+ecosa2
3114 ecosbp=ecosb1+ecosb2
3115 ecosgp=ecosg1+ecosg2
3116 ecosam=ecosa1-ecosa2
3117 ecosbm=ecosb1-ecosb2
3118 ecosgm=ecosg1-ecosg2
3127 facont_hb(num_conti,i)=fcont
3128 fprimcont=fprimcont/rij
3129 cd facont_hb(num_conti,i)=1.0D0
3130 C Following line is for diagnostics.
3133 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3134 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3137 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3138 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3140 gggp(1)=gggp(1)+ees0pijp*xj
3141 gggp(2)=gggp(2)+ees0pijp*yj
3142 gggp(3)=gggp(3)+ees0pijp*zj
3143 gggm(1)=gggm(1)+ees0mijp*xj
3144 gggm(2)=gggm(2)+ees0mijp*yj
3145 gggm(3)=gggm(3)+ees0mijp*zj
3146 C Derivatives due to the contact function
3147 gacont_hbr(1,num_conti,i)=fprimcont*xj
3148 gacont_hbr(2,num_conti,i)=fprimcont*yj
3149 gacont_hbr(3,num_conti,i)=fprimcont*zj
3151 ghalfp=0.5D0*gggp(k)
3152 ghalfm=0.5D0*gggm(k)
3153 gacontp_hb1(k,num_conti,i)=ghalfp
3154 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3155 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3156 gacontp_hb2(k,num_conti,i)=ghalfp
3157 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3158 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3159 gacontp_hb3(k,num_conti,i)=gggp(k)
3160 gacontm_hb1(k,num_conti,i)=ghalfm
3161 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3162 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3163 gacontm_hb2(k,num_conti,i)=ghalfm
3164 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3165 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3166 gacontm_hb3(k,num_conti,i)=gggm(k)
3168 C Diagnostics. Comment out or remove after debugging!
3170 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3171 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3172 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3173 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3174 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3175 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3178 endif ! num_conti.le.maxconts
3182 num_cont_hb(i)=num_conti
3184 c write (iout,*) "Number of loop steps in EELEC:",ind
3186 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3187 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3189 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3190 ccc eel_loc=eel_loc+eello_turn3
3193 C-----------------------------------------------------------------------------
3194 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3195 C Third- and fourth-order contributions from turns
3196 implicit real*8 (a-h,o-z)
3197 include 'DIMENSIONS'
3198 include 'COMMON.IOUNITS'
3199 include 'COMMON.GEO'
3200 include 'COMMON.VAR'
3201 include 'COMMON.LOCAL'
3202 include 'COMMON.CHAIN'
3203 include 'COMMON.DERIV'
3204 include 'COMMON.INTERACT'
3205 include 'COMMON.CONTACTS'
3206 include 'COMMON.TORSION'
3207 include 'COMMON.VECTORS'
3208 include 'COMMON.FFIELD'
3209 include 'COMMON.CONTROL'
3211 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3212 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3213 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3214 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3215 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3216 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3218 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3220 C Third-order contributions
3227 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3228 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3229 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3230 call transpose2(auxmat(1,1),auxmat1(1,1))
3231 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3232 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3233 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3234 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3235 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3236 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3237 cd & ' eello_turn3_num',4*eello_turn3_num
3238 C Derivatives in gamma(i)
3239 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3240 call transpose2(auxmat2(1,1),auxmat3(1,1))
3241 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3242 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3243 C Derivatives in gamma(i+1)
3244 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3245 call transpose2(auxmat2(1,1),auxmat3(1,1))
3246 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3247 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3248 & +0.5d0*(pizda(1,1)+pizda(2,2))
3249 C Cartesian derivatives
3251 a_temp(1,1)=aggi(l,1)
3252 a_temp(1,2)=aggi(l,2)
3253 a_temp(2,1)=aggi(l,3)
3254 a_temp(2,2)=aggi(l,4)
3255 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3256 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3257 & +0.5d0*(pizda(1,1)+pizda(2,2))
3258 a_temp(1,1)=aggi1(l,1)
3259 a_temp(1,2)=aggi1(l,2)
3260 a_temp(2,1)=aggi1(l,3)
3261 a_temp(2,2)=aggi1(l,4)
3262 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3263 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3264 & +0.5d0*(pizda(1,1)+pizda(2,2))
3265 a_temp(1,1)=aggj(l,1)
3266 a_temp(1,2)=aggj(l,2)
3267 a_temp(2,1)=aggj(l,3)
3268 a_temp(2,2)=aggj(l,4)
3269 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3270 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3271 & +0.5d0*(pizda(1,1)+pizda(2,2))
3272 a_temp(1,1)=aggj1(l,1)
3273 a_temp(1,2)=aggj1(l,2)
3274 a_temp(2,1)=aggj1(l,3)
3275 a_temp(2,2)=aggj1(l,4)
3276 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3277 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3278 & +0.5d0*(pizda(1,1)+pizda(2,2))
3280 else if (j.eq.i+3) then
3281 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3283 C Fourth-order contributions
3291 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3292 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3293 iti1=itortyp(itype(i+1))
3294 iti2=itortyp(itype(i+2))
3295 iti3=itortyp(itype(i+3))
3296 call transpose2(EUg(1,1,i+1),e1t(1,1))
3297 call transpose2(Eug(1,1,i+2),e2t(1,1))
3298 call transpose2(Eug(1,1,i+3),e3t(1,1))
3299 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3300 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3301 s1=scalar2(b1(1,iti2),auxvec(1))
3302 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3303 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3304 s2=scalar2(b1(1,iti1),auxvec(1))
3305 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3306 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3307 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3308 eello_turn4=eello_turn4-(s1+s2+s3)
3309 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3310 & 'eturn4',i,j,-(s1+s2+s3)
3311 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3312 cd & ' eello_turn4_num',8*eello_turn4_num
3313 C Derivatives in gamma(i)
3314 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3315 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3316 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3317 s1=scalar2(b1(1,iti2),auxvec(1))
3318 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3319 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3320 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3321 C Derivatives in gamma(i+1)
3322 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3323 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3324 s2=scalar2(b1(1,iti1),auxvec(1))
3325 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3326 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3327 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3328 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3329 C Derivatives in gamma(i+2)
3330 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3331 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3332 s1=scalar2(b1(1,iti2),auxvec(1))
3333 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3334 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3335 s2=scalar2(b1(1,iti1),auxvec(1))
3336 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3337 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3338 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3339 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3340 C Cartesian derivatives
3341 C Derivatives of this turn contributions in DC(i+2)
3342 if (j.lt.nres-1) then
3344 a_temp(1,1)=agg(l,1)
3345 a_temp(1,2)=agg(l,2)
3346 a_temp(2,1)=agg(l,3)
3347 a_temp(2,2)=agg(l,4)
3348 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3349 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3350 s1=scalar2(b1(1,iti2),auxvec(1))
3351 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3352 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3353 s2=scalar2(b1(1,iti1),auxvec(1))
3354 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3355 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3356 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3358 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3361 C Remaining derivatives of this turn contribution
3363 a_temp(1,1)=aggi(l,1)
3364 a_temp(1,2)=aggi(l,2)
3365 a_temp(2,1)=aggi(l,3)
3366 a_temp(2,2)=aggi(l,4)
3367 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3368 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3369 s1=scalar2(b1(1,iti2),auxvec(1))
3370 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3371 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3372 s2=scalar2(b1(1,iti1),auxvec(1))
3373 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3374 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3375 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3376 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3377 a_temp(1,1)=aggi1(l,1)
3378 a_temp(1,2)=aggi1(l,2)
3379 a_temp(2,1)=aggi1(l,3)
3380 a_temp(2,2)=aggi1(l,4)
3381 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3382 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3383 s1=scalar2(b1(1,iti2),auxvec(1))
3384 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3385 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3386 s2=scalar2(b1(1,iti1),auxvec(1))
3387 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3388 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3389 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3390 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3391 a_temp(1,1)=aggj(l,1)
3392 a_temp(1,2)=aggj(l,2)
3393 a_temp(2,1)=aggj(l,3)
3394 a_temp(2,2)=aggj(l,4)
3395 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3396 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3397 s1=scalar2(b1(1,iti2),auxvec(1))
3398 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3399 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3400 s2=scalar2(b1(1,iti1),auxvec(1))
3401 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3402 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3403 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3404 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3405 a_temp(1,1)=aggj1(l,1)
3406 a_temp(1,2)=aggj1(l,2)
3407 a_temp(2,1)=aggj1(l,3)
3408 a_temp(2,2)=aggj1(l,4)
3409 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3410 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3411 s1=scalar2(b1(1,iti2),auxvec(1))
3412 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3413 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3414 s2=scalar2(b1(1,iti1),auxvec(1))
3415 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3416 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3417 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3418 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3423 C-----------------------------------------------------------------------------
3424 subroutine vecpr(u,v,w)
3425 implicit real*8(a-h,o-z)
3426 dimension u(3),v(3),w(3)
3427 w(1)=u(2)*v(3)-u(3)*v(2)
3428 w(2)=-u(1)*v(3)+u(3)*v(1)
3429 w(3)=u(1)*v(2)-u(2)*v(1)
3432 C-----------------------------------------------------------------------------
3433 subroutine unormderiv(u,ugrad,unorm,ungrad)
3434 C This subroutine computes the derivatives of a normalized vector u, given
3435 C the derivatives computed without normalization conditions, ugrad. Returns
3438 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3439 double precision vec(3)
3440 double precision scalar
3442 c write (2,*) 'ugrad',ugrad
3445 vec(i)=scalar(ugrad(1,i),u(1))
3447 c write (2,*) 'vec',vec
3450 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3453 c write (2,*) 'ungrad',ungrad
3456 C-----------------------------------------------------------------------------
3457 subroutine escp_soft_sphere(evdw2,evdw2_14)
3459 C This subroutine calculates the excluded-volume interaction energy between
3460 C peptide-group centers and side chains and its gradient in virtual-bond and
3461 C side-chain vectors.
3463 implicit real*8 (a-h,o-z)
3464 include 'DIMENSIONS'
3465 include 'COMMON.GEO'
3466 include 'COMMON.VAR'
3467 include 'COMMON.LOCAL'
3468 include 'COMMON.CHAIN'
3469 include 'COMMON.DERIV'
3470 include 'COMMON.INTERACT'
3471 include 'COMMON.FFIELD'
3472 include 'COMMON.IOUNITS'
3473 include 'COMMON.CONTROL'
3478 cd print '(a)','Enter ESCP'
3479 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3480 do i=iatscp_s,iatscp_e
3482 xi=0.5D0*(c(1,i)+c(1,i+1))
3483 yi=0.5D0*(c(2,i)+c(2,i+1))
3484 zi=0.5D0*(c(3,i)+c(3,i+1))
3486 do iint=1,nscp_gr(i)
3488 do j=iscpstart(i,iint),iscpend(i,iint)
3490 C Uncomment following three lines for SC-p interactions
3494 C Uncomment following three lines for Ca-p interactions
3498 rij=xj*xj+yj*yj+zj*zj
3501 if (rij.lt.r0ijsq) then
3502 evdwij=0.25d0*(rij-r0ijsq)**2
3510 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3516 cd write (iout,*) 'j<i'
3517 C Uncomment following three lines for SC-p interactions
3519 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3522 cd write (iout,*) 'j>i'
3525 C Uncomment following line for SC-p interactions
3526 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3530 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3534 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3535 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3538 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3547 C-----------------------------------------------------------------------------
3548 subroutine escp(evdw2,evdw2_14)
3550 C This subroutine calculates the excluded-volume interaction energy between
3551 C peptide-group centers and side chains and its gradient in virtual-bond and
3552 C side-chain vectors.
3554 implicit real*8 (a-h,o-z)
3555 include 'DIMENSIONS'
3556 include 'COMMON.GEO'
3557 include 'COMMON.VAR'
3558 include 'COMMON.LOCAL'
3559 include 'COMMON.CHAIN'
3560 include 'COMMON.DERIV'
3561 include 'COMMON.INTERACT'
3562 include 'COMMON.FFIELD'
3563 include 'COMMON.IOUNITS'
3564 include 'COMMON.CONTROL'
3568 cd print '(a)','Enter ESCP'
3569 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3570 do i=iatscp_s,iatscp_e
3572 xi=0.5D0*(c(1,i)+c(1,i+1))
3573 yi=0.5D0*(c(2,i)+c(2,i+1))
3574 zi=0.5D0*(c(3,i)+c(3,i+1))
3576 do iint=1,nscp_gr(i)
3578 do j=iscpstart(i,iint),iscpend(i,iint)
3580 C Uncomment following three lines for SC-p interactions
3584 C Uncomment following three lines for Ca-p interactions
3588 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3590 e1=fac*fac*aad(itypj,iteli)
3591 e2=fac*bad(itypj,iteli)
3592 if (iabs(j-i) .le. 2) then
3595 evdw2_14=evdw2_14+e1+e2
3599 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3600 & 'evdw2',i,j,evdwij
3602 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3604 fac=-(evdwij+e1)*rrij
3609 cd write (iout,*) 'j<i'
3610 C Uncomment following three lines for SC-p interactions
3612 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3615 cd write (iout,*) 'j>i'
3618 C Uncomment following line for SC-p interactions
3619 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3623 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3627 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3628 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3631 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3640 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3641 gradx_scp(j,i)=expon*gradx_scp(j,i)
3644 C******************************************************************************
3648 C To save time the factor EXPON has been extracted from ALL components
3649 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3652 C******************************************************************************
3655 C--------------------------------------------------------------------------
3656 subroutine edis(ehpb)
3658 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3660 implicit real*8 (a-h,o-z)
3661 include 'DIMENSIONS'
3662 include 'COMMON.SBRIDGE'
3663 include 'COMMON.CHAIN'
3664 include 'COMMON.DERIV'
3665 include 'COMMON.VAR'
3666 include 'COMMON.INTERACT'
3669 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3670 cd print *,'link_start=',link_start,' link_end=',link_end
3671 if (link_end.eq.0) return
3672 do i=link_start,link_end
3673 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3674 C CA-CA distance used in regularization of structure.
3677 C iii and jjj point to the residues for which the distance is assigned.
3678 if (ii.gt.nres) then
3685 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3686 C distance and angle dependent SS bond potential.
3687 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3688 call ssbond_ene(iii,jjj,eij)
3691 C Calculate the distance between the two points and its difference from the
3695 C Get the force constant corresponding to this distance.
3697 C Calculate the contribution to energy.
3698 ehpb=ehpb+waga*rdis*rdis
3700 C Evaluate gradient.
3703 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3704 cd & ' waga=',waga,' fac=',fac
3706 ggg(j)=fac*(c(j,jj)-c(j,ii))
3708 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3709 C If this is a SC-SC distance, we need to calculate the contributions to the
3710 C Cartesian gradient in the SC vectors (ghpbx).
3713 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3714 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3719 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3727 C--------------------------------------------------------------------------
3728 subroutine ssbond_ene(i,j,eij)
3730 C Calculate the distance and angle dependent SS-bond potential energy
3731 C using a free-energy function derived based on RHF/6-31G** ab initio
3732 C calculations of diethyl disulfide.
3734 C A. Liwo and U. Kozlowska, 11/24/03
3736 implicit real*8 (a-h,o-z)
3737 include 'DIMENSIONS'
3738 include 'COMMON.SBRIDGE'
3739 include 'COMMON.CHAIN'
3740 include 'COMMON.DERIV'
3741 include 'COMMON.LOCAL'
3742 include 'COMMON.INTERACT'
3743 include 'COMMON.VAR'
3744 include 'COMMON.IOUNITS'
3745 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3750 dxi=dc_norm(1,nres+i)
3751 dyi=dc_norm(2,nres+i)
3752 dzi=dc_norm(3,nres+i)
3753 dsci_inv=dsc_inv(itypi)
3755 dscj_inv=dsc_inv(itypj)
3759 dxj=dc_norm(1,nres+j)
3760 dyj=dc_norm(2,nres+j)
3761 dzj=dc_norm(3,nres+j)
3762 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3767 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3768 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3769 om12=dxi*dxj+dyi*dyj+dzi*dzj
3771 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3772 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3778 deltat12=om2-om1+2.0d0
3780 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3781 & +akct*deltad*deltat12
3782 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3783 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3784 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3785 c & " deltat12",deltat12," eij",eij
3786 ed=2*akcm*deltad+akct*deltat12
3788 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3789 eom1=-2*akth*deltat1-pom1-om2*pom2
3790 eom2= 2*akth*deltat2+pom1-om1*pom2
3793 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3796 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3797 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3798 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3799 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3802 C Calculate the components of the gradient in DC and X
3806 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3811 C--------------------------------------------------------------------------
3812 subroutine ebond(estr)
3814 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3816 implicit real*8 (a-h,o-z)
3817 include 'DIMENSIONS'
3818 include 'COMMON.LOCAL'
3819 include 'COMMON.GEO'
3820 include 'COMMON.INTERACT'
3821 include 'COMMON.DERIV'
3822 include 'COMMON.VAR'
3823 include 'COMMON.CHAIN'
3824 include 'COMMON.IOUNITS'
3825 include 'COMMON.NAMES'
3826 include 'COMMON.FFIELD'
3827 include 'COMMON.CONTROL'
3828 include 'COMMON.SETUP'
3829 double precision u(3),ud(3)
3831 do i=ibondp_start,ibondp_end
3832 diff = vbld(i)-vbldp0
3833 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3836 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3838 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
3842 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3844 do i=ibond_start,ibond_end
3849 diff=vbld(i+nres)-vbldsc0(1,iti)
3850 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3851 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3852 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3854 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3858 diff=vbld(i+nres)-vbldsc0(j,iti)
3859 ud(j)=aksc(j,iti)*diff
3860 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3874 uprod2=uprod2*u(k)*u(k)
3878 usumsqder=usumsqder+ud(j)*uprod2
3880 estr=estr+uprod/usum
3882 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3890 C--------------------------------------------------------------------------
3891 subroutine ebend(etheta)
3893 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3894 C angles gamma and its derivatives in consecutive thetas and gammas.
3896 implicit real*8 (a-h,o-z)
3897 include 'DIMENSIONS'
3898 include 'COMMON.LOCAL'
3899 include 'COMMON.GEO'
3900 include 'COMMON.INTERACT'
3901 include 'COMMON.DERIV'
3902 include 'COMMON.VAR'
3903 include 'COMMON.CHAIN'
3904 include 'COMMON.IOUNITS'
3905 include 'COMMON.NAMES'
3906 include 'COMMON.FFIELD'
3907 include 'COMMON.CONTROL'
3908 common /calcthet/ term1,term2,termm,diffak,ratak,
3909 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3910 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3911 double precision y(2),z(2)
3913 c time11=dexp(-2*time)
3916 c write (*,'(a,i2)') 'EBEND ICG=',icg
3917 do i=ithet_start,ithet_end
3918 C Zero the energy function and its derivative at 0 or pi.
3919 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3924 if (phii.ne.phii) phii=150.0
3937 if (phii1.ne.phii1) phii1=150.0
3949 C Calculate the "mean" value of theta from the part of the distribution
3950 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3951 C In following comments this theta will be referred to as t_c.
3952 thet_pred_mean=0.0d0
3956 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3958 dthett=thet_pred_mean*ssd
3959 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3960 C Derivatives of the "mean" values in gamma1 and gamma2.
3961 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3962 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3963 if (theta(i).gt.pi-delta) then
3964 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3966 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3967 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3968 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3970 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3972 else if (theta(i).lt.delta) then
3973 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3974 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3975 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3977 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3978 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3981 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3984 etheta=etheta+ethetai
3985 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
3987 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3988 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3989 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3991 C Ufff.... We've done all this!!!
3994 C---------------------------------------------------------------------------
3995 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3997 implicit real*8 (a-h,o-z)
3998 include 'DIMENSIONS'
3999 include 'COMMON.LOCAL'
4000 include 'COMMON.IOUNITS'
4001 common /calcthet/ term1,term2,termm,diffak,ratak,
4002 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4003 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4004 C Calculate the contributions to both Gaussian lobes.
4005 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4006 C The "polynomial part" of the "standard deviation" of this part of
4010 sig=sig*thet_pred_mean+polthet(j,it)
4012 C Derivative of the "interior part" of the "standard deviation of the"
4013 C gamma-dependent Gaussian lobe in t_c.
4014 sigtc=3*polthet(3,it)
4016 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4019 C Set the parameters of both Gaussian lobes of the distribution.
4020 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4021 fac=sig*sig+sigc0(it)
4024 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4025 sigsqtc=-4.0D0*sigcsq*sigtc
4026 c print *,i,sig,sigtc,sigsqtc
4027 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4028 sigtc=-sigtc/(fac*fac)
4029 C Following variable is sigma(t_c)**(-2)
4030 sigcsq=sigcsq*sigcsq
4032 sig0inv=1.0D0/sig0i**2
4033 delthec=thetai-thet_pred_mean
4034 delthe0=thetai-theta0i
4035 term1=-0.5D0*sigcsq*delthec*delthec
4036 term2=-0.5D0*sig0inv*delthe0*delthe0
4037 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4038 C NaNs in taking the logarithm. We extract the largest exponent which is added
4039 C to the energy (this being the log of the distribution) at the end of energy
4040 C term evaluation for this virtual-bond angle.
4041 if (term1.gt.term2) then
4043 term2=dexp(term2-termm)
4047 term1=dexp(term1-termm)
4050 C The ratio between the gamma-independent and gamma-dependent lobes of
4051 C the distribution is a Gaussian function of thet_pred_mean too.
4052 diffak=gthet(2,it)-thet_pred_mean
4053 ratak=diffak/gthet(3,it)**2
4054 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4055 C Let's differentiate it in thet_pred_mean NOW.
4057 C Now put together the distribution terms to make complete distribution.
4058 termexp=term1+ak*term2
4059 termpre=sigc+ak*sig0i
4060 C Contribution of the bending energy from this theta is just the -log of
4061 C the sum of the contributions from the two lobes and the pre-exponential
4062 C factor. Simple enough, isn't it?
4063 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4064 C NOW the derivatives!!!
4065 C 6/6/97 Take into account the deformation.
4066 E_theta=(delthec*sigcsq*term1
4067 & +ak*delthe0*sig0inv*term2)/termexp
4068 E_tc=((sigtc+aktc*sig0i)/termpre
4069 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4070 & aktc*term2)/termexp)
4073 c-----------------------------------------------------------------------------
4074 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4075 implicit real*8 (a-h,o-z)
4076 include 'DIMENSIONS'
4077 include 'COMMON.LOCAL'
4078 include 'COMMON.IOUNITS'
4079 common /calcthet/ term1,term2,termm,diffak,ratak,
4080 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4081 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4082 delthec=thetai-thet_pred_mean
4083 delthe0=thetai-theta0i
4084 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4085 t3 = thetai-thet_pred_mean
4089 t14 = t12+t6*sigsqtc
4091 t21 = thetai-theta0i
4097 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4098 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4099 & *(-t12*t9-ak*sig0inv*t27)
4103 C--------------------------------------------------------------------------
4104 subroutine ebend(etheta)
4106 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4107 C angles gamma and its derivatives in consecutive thetas and gammas.
4108 C ab initio-derived potentials from
4109 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4111 implicit real*8 (a-h,o-z)
4112 include 'DIMENSIONS'
4113 include 'COMMON.LOCAL'
4114 include 'COMMON.GEO'
4115 include 'COMMON.INTERACT'
4116 include 'COMMON.DERIV'
4117 include 'COMMON.VAR'
4118 include 'COMMON.CHAIN'
4119 include 'COMMON.IOUNITS'
4120 include 'COMMON.NAMES'
4121 include 'COMMON.FFIELD'
4122 include 'COMMON.CONTROL'
4123 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4124 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4125 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4126 & sinph1ph2(maxdouble,maxdouble)
4127 logical lprn /.false./, lprn1 /.false./
4129 do i=ithet_start,ithet_end
4133 theti2=0.5d0*theta(i)
4134 ityp2=ithetyp(itype(i-1))
4136 coskt(k)=dcos(k*theti2)
4137 sinkt(k)=dsin(k*theti2)
4142 if (phii.ne.phii) phii=150.0
4146 ityp1=ithetyp(itype(i-2))
4148 cosph1(k)=dcos(k*phii)
4149 sinph1(k)=dsin(k*phii)
4162 if (phii1.ne.phii1) phii1=150.0
4167 ityp3=ithetyp(itype(i))
4169 cosph2(k)=dcos(k*phii1)
4170 sinph2(k)=dsin(k*phii1)
4180 ethetai=aa0thet(ityp1,ityp2,ityp3)
4183 ccl=cosph1(l)*cosph2(k-l)
4184 ssl=sinph1(l)*sinph2(k-l)
4185 scl=sinph1(l)*cosph2(k-l)
4186 csl=cosph1(l)*sinph2(k-l)
4187 cosph1ph2(l,k)=ccl-ssl
4188 cosph1ph2(k,l)=ccl+ssl
4189 sinph1ph2(l,k)=scl+csl
4190 sinph1ph2(k,l)=scl-csl
4194 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4195 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4196 write (iout,*) "coskt and sinkt"
4198 write (iout,*) k,coskt(k),sinkt(k)
4202 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4203 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4206 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4207 & " ethetai",ethetai
4210 write (iout,*) "cosph and sinph"
4212 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4214 write (iout,*) "cosph1ph2 and sinph2ph2"
4217 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4218 & sinph1ph2(l,k),sinph1ph2(k,l)
4221 write(iout,*) "ethetai",ethetai
4225 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4226 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4227 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4228 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4229 ethetai=ethetai+sinkt(m)*aux
4230 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4231 dephii=dephii+k*sinkt(m)*(
4232 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4233 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4234 dephii1=dephii1+k*sinkt(m)*(
4235 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4236 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4238 & write (iout,*) "m",m," k",k," bbthet",
4239 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4240 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4241 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4242 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4246 & write(iout,*) "ethetai",ethetai
4250 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4251 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4252 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4253 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4254 ethetai=ethetai+sinkt(m)*aux
4255 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4256 dephii=dephii+l*sinkt(m)*(
4257 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4258 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4259 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4260 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4261 dephii1=dephii1+(k-l)*sinkt(m)*(
4262 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4263 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4264 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4265 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4267 write (iout,*) "m",m," k",k," l",l," ffthet",
4268 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4269 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4270 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4271 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4272 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4273 & cosph1ph2(k,l)*sinkt(m),
4274 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4280 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4281 & i,theta(i)*rad2deg,phii*rad2deg,
4282 & phii1*rad2deg,ethetai
4283 etheta=etheta+ethetai
4284 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4285 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4286 gloc(nphi+i-2,icg)=wang*dethetai
4292 c-----------------------------------------------------------------------------
4293 subroutine esc(escloc)
4294 C Calculate the local energy of a side chain and its derivatives in the
4295 C corresponding virtual-bond valence angles THETA and the spherical angles
4297 implicit real*8 (a-h,o-z)
4298 include 'DIMENSIONS'
4299 include 'COMMON.GEO'
4300 include 'COMMON.LOCAL'
4301 include 'COMMON.VAR'
4302 include 'COMMON.INTERACT'
4303 include 'COMMON.DERIV'
4304 include 'COMMON.CHAIN'
4305 include 'COMMON.IOUNITS'
4306 include 'COMMON.NAMES'
4307 include 'COMMON.FFIELD'
4308 include 'COMMON.CONTROL'
4309 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4310 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4311 common /sccalc/ time11,time12,time112,theti,it,nlobit
4314 c write (iout,'(a)') 'ESC'
4315 do i=loc_start,loc_end
4317 if (it.eq.10) goto 1
4319 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4320 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4321 theti=theta(i+1)-pipol
4326 if (x(2).gt.pi-delta) then
4330 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4332 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4333 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4335 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4336 & ddersc0(1),dersc(1))
4337 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4338 & ddersc0(3),dersc(3))
4340 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4342 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4343 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4344 & dersc0(2),esclocbi,dersc02)
4345 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4347 call splinthet(x(2),0.5d0*delta,ss,ssd)
4352 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4354 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4355 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4357 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4359 c write (iout,*) escloci
4360 else if (x(2).lt.delta) then
4364 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4366 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4367 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4369 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4370 & ddersc0(1),dersc(1))
4371 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4372 & ddersc0(3),dersc(3))
4374 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4376 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4377 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4378 & dersc0(2),esclocbi,dersc02)
4379 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4384 call splinthet(x(2),0.5d0*delta,ss,ssd)
4386 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4388 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4389 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4391 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4392 c write (iout,*) escloci
4394 call enesc(x,escloci,dersc,ddummy,.false.)
4397 escloc=escloc+escloci
4398 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4399 & 'escloc',i,escloci
4400 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4402 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4404 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4405 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4410 C---------------------------------------------------------------------------
4411 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4412 implicit real*8 (a-h,o-z)
4413 include 'DIMENSIONS'
4414 include 'COMMON.GEO'
4415 include 'COMMON.LOCAL'
4416 include 'COMMON.IOUNITS'
4417 common /sccalc/ time11,time12,time112,theti,it,nlobit
4418 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4419 double precision contr(maxlob,-1:1)
4421 c write (iout,*) 'it=',it,' nlobit=',nlobit
4425 if (mixed) ddersc(j)=0.0d0
4429 C Because of periodicity of the dependence of the SC energy in omega we have
4430 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4431 C To avoid underflows, first compute & store the exponents.
4439 z(k)=x(k)-censc(k,j,it)
4444 Axk=Axk+gaussc(l,k,j,it)*z(l)
4450 expfac=expfac+Ax(k,j,iii)*z(k)
4458 C As in the case of ebend, we want to avoid underflows in exponentiation and
4459 C subsequent NaNs and INFs in energy calculation.
4460 C Find the largest exponent
4464 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4468 cd print *,'it=',it,' emin=',emin
4470 C Compute the contribution to SC energy and derivatives
4475 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4476 if(adexp.ne.adexp) adexp=1.0
4479 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4481 cd print *,'j=',j,' expfac=',expfac
4482 escloc_i=escloc_i+expfac
4484 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4488 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4489 & +gaussc(k,2,j,it))*expfac
4496 dersc(1)=dersc(1)/cos(theti)**2
4497 ddersc(1)=ddersc(1)/cos(theti)**2
4500 escloci=-(dlog(escloc_i)-emin)
4502 dersc(j)=dersc(j)/escloc_i
4506 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4511 C------------------------------------------------------------------------------
4512 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4513 implicit real*8 (a-h,o-z)
4514 include 'DIMENSIONS'
4515 include 'COMMON.GEO'
4516 include 'COMMON.LOCAL'
4517 include 'COMMON.IOUNITS'
4518 common /sccalc/ time11,time12,time112,theti,it,nlobit
4519 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4520 double precision contr(maxlob)
4531 z(k)=x(k)-censc(k,j,it)
4537 Axk=Axk+gaussc(l,k,j,it)*z(l)
4543 expfac=expfac+Ax(k,j)*z(k)
4548 C As in the case of ebend, we want to avoid underflows in exponentiation and
4549 C subsequent NaNs and INFs in energy calculation.
4550 C Find the largest exponent
4553 if (emin.gt.contr(j)) emin=contr(j)
4557 C Compute the contribution to SC energy and derivatives
4561 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4562 escloc_i=escloc_i+expfac
4564 dersc(k)=dersc(k)+Ax(k,j)*expfac
4566 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4567 & +gaussc(1,2,j,it))*expfac
4571 dersc(1)=dersc(1)/cos(theti)**2
4572 dersc12=dersc12/cos(theti)**2
4573 escloci=-(dlog(escloc_i)-emin)
4575 dersc(j)=dersc(j)/escloc_i
4577 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4581 c----------------------------------------------------------------------------------
4582 subroutine esc(escloc)
4583 C Calculate the local energy of a side chain and its derivatives in the
4584 C corresponding virtual-bond valence angles THETA and the spherical angles
4585 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4586 C added by Urszula Kozlowska. 07/11/2007
4588 implicit real*8 (a-h,o-z)
4589 include 'DIMENSIONS'
4590 include 'COMMON.GEO'
4591 include 'COMMON.LOCAL'
4592 include 'COMMON.VAR'
4593 include 'COMMON.SCROT'
4594 include 'COMMON.INTERACT'
4595 include 'COMMON.DERIV'
4596 include 'COMMON.CHAIN'
4597 include 'COMMON.IOUNITS'
4598 include 'COMMON.NAMES'
4599 include 'COMMON.FFIELD'
4600 include 'COMMON.CONTROL'
4601 include 'COMMON.VECTORS'
4602 double precision x_prime(3),y_prime(3),z_prime(3)
4603 & , sumene,dsc_i,dp2_i,x(65),
4604 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4605 & de_dxx,de_dyy,de_dzz,de_dt
4606 double precision s1_t,s1_6_t,s2_t,s2_6_t
4608 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4609 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4610 & dt_dCi(3),dt_dCi1(3)
4611 common /sccalc/ time11,time12,time112,theti,it,nlobit
4614 do i=loc_start,loc_end
4615 costtab(i+1) =dcos(theta(i+1))
4616 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4617 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4618 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4619 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4620 cosfac=dsqrt(cosfac2)
4621 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4622 sinfac=dsqrt(sinfac2)
4624 if (it.eq.10) goto 1
4626 C Compute the axes of tghe local cartesian coordinates system; store in
4627 c x_prime, y_prime and z_prime
4634 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4635 C & dc_norm(3,i+nres)
4637 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4638 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4641 z_prime(j) = -uz(j,i-1)
4644 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4645 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4646 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4647 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4648 c & " xy",scalar(x_prime(1),y_prime(1)),
4649 c & " xz",scalar(x_prime(1),z_prime(1)),
4650 c & " yy",scalar(y_prime(1),y_prime(1)),
4651 c & " yz",scalar(y_prime(1),z_prime(1)),
4652 c & " zz",scalar(z_prime(1),z_prime(1))
4654 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4655 C to local coordinate system. Store in xx, yy, zz.
4661 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4662 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4663 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4670 C Compute the energy of the ith side cbain
4672 c write (2,*) "xx",xx," yy",yy," zz",zz
4675 x(j) = sc_parmin(j,it)
4678 Cc diagnostics - remove later
4680 yy1 = dsin(alph(2))*dcos(omeg(2))
4681 zz1 = -dsin(alph(2))*dsin(omeg(2))
4682 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4683 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4685 C," --- ", xx_w,yy_w,zz_w
4688 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4689 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4691 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4692 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4694 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4695 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4696 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4697 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4698 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4700 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4701 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4702 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4703 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4704 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4706 dsc_i = 0.743d0+x(61)
4708 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4709 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4710 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4711 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4712 s1=(1+x(63))/(0.1d0 + dscp1)
4713 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4714 s2=(1+x(65))/(0.1d0 + dscp2)
4715 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4716 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4717 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4718 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4720 c & dscp1,dscp2,sumene
4721 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4722 escloc = escloc + sumene
4723 c write (2,*) "i",i," escloc",sumene,escloc
4726 C This section to check the numerical derivatives of the energy of ith side
4727 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4728 C #define DEBUG in the code to turn it on.
4730 write (2,*) "sumene =",sumene
4734 write (2,*) xx,yy,zz
4735 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4736 de_dxx_num=(sumenep-sumene)/aincr
4738 write (2,*) "xx+ sumene from enesc=",sumenep
4741 write (2,*) xx,yy,zz
4742 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4743 de_dyy_num=(sumenep-sumene)/aincr
4745 write (2,*) "yy+ sumene from enesc=",sumenep
4748 write (2,*) xx,yy,zz
4749 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4750 de_dzz_num=(sumenep-sumene)/aincr
4752 write (2,*) "zz+ sumene from enesc=",sumenep
4753 costsave=cost2tab(i+1)
4754 sintsave=sint2tab(i+1)
4755 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4756 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4757 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4758 de_dt_num=(sumenep-sumene)/aincr
4759 write (2,*) " t+ sumene from enesc=",sumenep
4760 cost2tab(i+1)=costsave
4761 sint2tab(i+1)=sintsave
4762 C End of diagnostics section.
4765 C Compute the gradient of esc
4767 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4768 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4769 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4770 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4771 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4772 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4773 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4774 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4775 pom1=(sumene3*sint2tab(i+1)+sumene1)
4776 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4777 pom2=(sumene4*cost2tab(i+1)+sumene2)
4778 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4779 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4780 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4781 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4783 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4784 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4785 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4787 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4788 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4789 & +(pom1+pom2)*pom_dx
4791 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4794 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4795 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4796 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4798 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4799 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4800 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4801 & +x(59)*zz**2 +x(60)*xx*zz
4802 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4803 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4804 & +(pom1-pom2)*pom_dy
4806 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4809 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4810 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4811 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4812 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4813 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4814 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4815 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4816 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4818 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4821 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4822 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4823 & +pom1*pom_dt1+pom2*pom_dt2
4825 write(2,*), "de_dt = ", de_dt,de_dt_num
4829 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4830 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4831 cosfac2xx=cosfac2*xx
4832 sinfac2yy=sinfac2*yy
4834 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4836 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4838 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4839 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4840 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4841 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4842 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4843 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4844 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4845 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4846 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4847 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4851 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4852 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4855 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4856 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4857 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4859 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4860 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4864 dXX_Ctab(k,i)=dXX_Ci(k)
4865 dXX_C1tab(k,i)=dXX_Ci1(k)
4866 dYY_Ctab(k,i)=dYY_Ci(k)
4867 dYY_C1tab(k,i)=dYY_Ci1(k)
4868 dZZ_Ctab(k,i)=dZZ_Ci(k)
4869 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4870 dXX_XYZtab(k,i)=dXX_XYZ(k)
4871 dYY_XYZtab(k,i)=dYY_XYZ(k)
4872 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4876 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4877 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4878 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4879 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4880 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4882 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4883 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4884 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4885 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4886 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4887 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4888 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4889 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4891 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4892 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4894 C to check gradient call subroutine check_grad
4900 c------------------------------------------------------------------------------
4901 double precision function enesc(x,xx,yy,zz,cost2,sint2)
4903 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
4904 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
4905 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4906 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4908 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4909 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4911 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4912 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4913 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4914 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4915 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4917 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4918 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4919 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4920 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4921 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4923 dsc_i = 0.743d0+x(61)
4925 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4926 & *(xx*cost2+yy*sint2))
4927 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4928 & *(xx*cost2-yy*sint2))
4929 s1=(1+x(63))/(0.1d0 + dscp1)
4930 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4931 s2=(1+x(65))/(0.1d0 + dscp2)
4932 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4933 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
4934 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
4939 c------------------------------------------------------------------------------
4940 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4942 C This procedure calculates two-body contact function g(rij) and its derivative:
4945 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4948 C where x=(rij-r0ij)/delta
4950 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4953 double precision rij,r0ij,eps0ij,fcont,fprimcont
4954 double precision x,x2,x4,delta
4958 if (x.lt.-1.0D0) then
4961 else if (x.le.1.0D0) then
4964 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4965 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4972 c------------------------------------------------------------------------------
4973 subroutine splinthet(theti,delta,ss,ssder)
4974 implicit real*8 (a-h,o-z)
4975 include 'DIMENSIONS'
4976 include 'COMMON.VAR'
4977 include 'COMMON.GEO'
4980 if (theti.gt.pipol) then
4981 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4983 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4988 c------------------------------------------------------------------------------
4989 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4991 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4992 double precision ksi,ksi2,ksi3,a1,a2,a3
4993 a1=fprim0*delta/(f1-f0)
4999 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5000 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5003 c------------------------------------------------------------------------------
5004 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5006 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5007 double precision ksi,ksi2,ksi3,a1,a2,a3
5012 a2=3*(f1x-f0x)-2*fprim0x*delta
5013 a3=fprim0x*delta-2*(f1x-f0x)
5014 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5017 C-----------------------------------------------------------------------------
5019 C-----------------------------------------------------------------------------
5020 subroutine etor(etors,edihcnstr)
5021 implicit real*8 (a-h,o-z)
5022 include 'DIMENSIONS'
5023 include 'COMMON.VAR'
5024 include 'COMMON.GEO'
5025 include 'COMMON.LOCAL'
5026 include 'COMMON.TORSION'
5027 include 'COMMON.INTERACT'
5028 include 'COMMON.DERIV'
5029 include 'COMMON.CHAIN'
5030 include 'COMMON.NAMES'
5031 include 'COMMON.IOUNITS'
5032 include 'COMMON.FFIELD'
5033 include 'COMMON.TORCNSTR'
5034 include 'COMMON.CONTROL'
5036 C Set lprn=.true. for debugging
5040 do i=iphi_start,iphi_end
5042 itori=itortyp(itype(i-2))
5043 itori1=itortyp(itype(i-1))
5046 C Proline-Proline pair is a special case...
5047 if (itori.eq.3 .and. itori1.eq.3) then
5048 if (phii.gt.-dwapi3) then
5050 fac=1.0D0/(1.0D0-cosphi)
5051 etorsi=v1(1,3,3)*fac
5052 etorsi=etorsi+etorsi
5053 etors=etors+etorsi-v1(1,3,3)
5054 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5055 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5058 v1ij=v1(j+1,itori,itori1)
5059 v2ij=v2(j+1,itori,itori1)
5062 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5063 if (energy_dec) etors_ii=etors_ii+
5064 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5065 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5069 v1ij=v1(j,itori,itori1)
5070 v2ij=v2(j,itori,itori1)
5073 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5074 if (energy_dec) etors_ii=etors_ii+
5075 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5076 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5079 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5082 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5083 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5084 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5085 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5086 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5088 ! 6/20/98 - dihedral angle constraints
5091 itori=idih_constr(i)
5094 if (difi.gt.drange(i)) then
5096 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5097 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5098 else if (difi.lt.-drange(i)) then
5100 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5101 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5103 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5104 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5106 ! write (iout,*) 'edihcnstr',edihcnstr
5109 c------------------------------------------------------------------------------
5110 subroutine etor_d(etors_d)
5114 c----------------------------------------------------------------------------
5116 subroutine etor(etors,edihcnstr)
5117 implicit real*8 (a-h,o-z)
5118 include 'DIMENSIONS'
5119 include 'COMMON.VAR'
5120 include 'COMMON.GEO'
5121 include 'COMMON.LOCAL'
5122 include 'COMMON.TORSION'
5123 include 'COMMON.INTERACT'
5124 include 'COMMON.DERIV'
5125 include 'COMMON.CHAIN'
5126 include 'COMMON.NAMES'
5127 include 'COMMON.IOUNITS'
5128 include 'COMMON.FFIELD'
5129 include 'COMMON.TORCNSTR'
5130 include 'COMMON.CONTROL'
5132 C Set lprn=.true. for debugging
5136 do i=iphi_start,iphi_end
5138 itori=itortyp(itype(i-2))
5139 itori1=itortyp(itype(i-1))
5142 C Regular cosine and sine terms
5143 do j=1,nterm(itori,itori1)
5144 v1ij=v1(j,itori,itori1)
5145 v2ij=v2(j,itori,itori1)
5148 etors=etors+v1ij*cosphi+v2ij*sinphi
5149 if (energy_dec) etors_ii=etors_ii+
5150 & v1ij*cosphi+v2ij*sinphi
5151 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5155 C E = SUM ----------------------------------- - v1
5156 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5158 cosphi=dcos(0.5d0*phii)
5159 sinphi=dsin(0.5d0*phii)
5160 do j=1,nlor(itori,itori1)
5161 vl1ij=vlor1(j,itori,itori1)
5162 vl2ij=vlor2(j,itori,itori1)
5163 vl3ij=vlor3(j,itori,itori1)
5164 pom=vl2ij*cosphi+vl3ij*sinphi
5165 pom1=1.0d0/(pom*pom+1.0d0)
5166 etors=etors+vl1ij*pom1
5167 if (energy_dec) etors_ii=etors_ii+
5170 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5172 C Subtract the constant term
5173 etors=etors-v0(itori,itori1)
5174 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5175 & 'etor',i,etors_ii-v0(itori,itori1)
5177 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5178 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5179 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5180 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5181 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5183 ! 6/20/98 - dihedral angle constraints
5185 c do i=1,ndih_constr
5186 do i=idihconstr_start,idihconstr_end
5187 itori=idih_constr(i)
5189 difi=pinorm(phii-phi0(i))
5190 if (difi.gt.drange(i)) then
5192 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5193 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5194 else if (difi.lt.-drange(i)) then
5196 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5197 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5201 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5202 cd & rad2deg*phi0(i), rad2deg*drange(i),
5203 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5205 cd write (iout,*) 'edihcnstr',edihcnstr
5208 c----------------------------------------------------------------------------
5209 subroutine etor_d(etors_d)
5210 C 6/23/01 Compute double torsional energy
5211 implicit real*8 (a-h,o-z)
5212 include 'DIMENSIONS'
5213 include 'COMMON.VAR'
5214 include 'COMMON.GEO'
5215 include 'COMMON.LOCAL'
5216 include 'COMMON.TORSION'
5217 include 'COMMON.INTERACT'
5218 include 'COMMON.DERIV'
5219 include 'COMMON.CHAIN'
5220 include 'COMMON.NAMES'
5221 include 'COMMON.IOUNITS'
5222 include 'COMMON.FFIELD'
5223 include 'COMMON.TORCNSTR'
5225 C Set lprn=.true. for debugging
5229 do i=iphid_start,iphid_end
5230 itori=itortyp(itype(i-2))
5231 itori1=itortyp(itype(i-1))
5232 itori2=itortyp(itype(i))
5237 C Regular cosine and sine terms
5238 do j=1,ntermd_1(itori,itori1,itori2)
5239 v1cij=v1c(1,j,itori,itori1,itori2)
5240 v1sij=v1s(1,j,itori,itori1,itori2)
5241 v2cij=v1c(2,j,itori,itori1,itori2)
5242 v2sij=v1s(2,j,itori,itori1,itori2)
5243 cosphi1=dcos(j*phii)
5244 sinphi1=dsin(j*phii)
5245 cosphi2=dcos(j*phii1)
5246 sinphi2=dsin(j*phii1)
5247 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5248 & v2cij*cosphi2+v2sij*sinphi2
5249 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5250 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5252 do k=2,ntermd_2(itori,itori1,itori2)
5254 v1cdij = v2c(k,l,itori,itori1,itori2)
5255 v2cdij = v2c(l,k,itori,itori1,itori2)
5256 v1sdij = v2s(k,l,itori,itori1,itori2)
5257 v2sdij = v2s(l,k,itori,itori1,itori2)
5258 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5259 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5260 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5261 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5262 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5263 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5264 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5265 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5266 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5267 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5270 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5271 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5276 c------------------------------------------------------------------------------
5277 subroutine eback_sc_corr(esccor)
5278 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5279 c conformational states; temporarily implemented as differences
5280 c between UNRES torsional potentials (dependent on three types of
5281 c residues) and the torsional potentials dependent on all 20 types
5282 c of residues computed from AM1 energy surfaces of terminally-blocked
5283 c amino-acid residues.
5284 implicit real*8 (a-h,o-z)
5285 include 'DIMENSIONS'
5286 include 'COMMON.VAR'
5287 include 'COMMON.GEO'
5288 include 'COMMON.LOCAL'
5289 include 'COMMON.TORSION'
5290 include 'COMMON.SCCOR'
5291 include 'COMMON.INTERACT'
5292 include 'COMMON.DERIV'
5293 include 'COMMON.CHAIN'
5294 include 'COMMON.NAMES'
5295 include 'COMMON.IOUNITS'
5296 include 'COMMON.FFIELD'
5297 include 'COMMON.CONTROL'
5299 C Set lprn=.true. for debugging
5302 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5304 do i=iphi_start,iphi_end
5311 v1ij=v1sccor(j,itori,itori1)
5312 v2ij=v2sccor(j,itori,itori1)
5315 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5316 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5319 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5320 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5321 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5322 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5326 c----------------------------------------------------------------------------
5327 subroutine multibody(ecorr)
5328 C This subroutine calculates multi-body contributions to energy following
5329 C the idea of Skolnick et al. If side chains I and J make a contact and
5330 C at the same time side chains I+1 and J+1 make a contact, an extra
5331 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5332 implicit real*8 (a-h,o-z)
5333 include 'DIMENSIONS'
5334 include 'COMMON.IOUNITS'
5335 include 'COMMON.DERIV'
5336 include 'COMMON.INTERACT'
5337 include 'COMMON.CONTACTS'
5338 double precision gx(3),gx1(3)
5341 C Set lprn=.true. for debugging
5345 write (iout,'(a)') 'Contact function values:'
5347 write (iout,'(i2,20(1x,i2,f10.5))')
5348 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5363 num_conti=num_cont(i)
5364 num_conti1=num_cont(i1)
5369 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5370 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5371 cd & ' ishift=',ishift
5372 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5373 C The system gains extra energy.
5374 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5375 endif ! j1==j+-ishift
5384 c------------------------------------------------------------------------------
5385 double precision function esccorr(i,j,k,l,jj,kk)
5386 implicit real*8 (a-h,o-z)
5387 include 'DIMENSIONS'
5388 include 'COMMON.IOUNITS'
5389 include 'COMMON.DERIV'
5390 include 'COMMON.INTERACT'
5391 include 'COMMON.CONTACTS'
5392 double precision gx(3),gx1(3)
5397 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5398 C Calculate the multi-body contribution to energy.
5399 C Calculate multi-body contributions to the gradient.
5400 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5401 cd & k,l,(gacont(m,kk,k),m=1,3)
5403 gx(m) =ekl*gacont(m,jj,i)
5404 gx1(m)=eij*gacont(m,kk,k)
5405 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5406 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5407 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5408 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5412 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5417 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5423 c------------------------------------------------------------------------------
5425 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5426 implicit real*8 (a-h,o-z)
5427 include 'DIMENSIONS'
5428 integer dimen1,dimen2,atom,indx
5429 double precision buffer(dimen1,dimen2)
5430 double precision zapas
5431 common /contacts_hb/ zapas(3,maxconts,maxres,8),
5432 & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5433 & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5434 & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5435 num_kont=num_cont_hb(atom)
5439 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5442 buffer(i,indx+25)=facont_hb(i,atom)
5443 buffer(i,indx+26)=ees0p(i,atom)
5444 buffer(i,indx+27)=ees0m(i,atom)
5445 buffer(i,indx+28)=d_cont(i,atom)
5446 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
5448 buffer(1,indx+30)=dfloat(num_kont)
5451 c------------------------------------------------------------------------------
5452 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5453 implicit real*8 (a-h,o-z)
5454 include 'DIMENSIONS'
5455 integer dimen1,dimen2,atom,indx
5456 double precision buffer(dimen1,dimen2)
5457 double precision zapas
5458 common /contacts_hb/ zapas(3,maxconts,maxres,8),
5459 & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5460 & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5461 & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5462 num_kont=buffer(1,indx+30)
5463 num_kont_old=num_cont_hb(atom)
5464 num_cont_hb(atom)=num_kont+num_kont_old
5469 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5472 facont_hb(ii,atom)=buffer(i,indx+25)
5473 ees0p(ii,atom)=buffer(i,indx+26)
5474 ees0m(ii,atom)=buffer(i,indx+27)
5475 d_cont(i,atom)=buffer(i,indx+28)
5476 jcont_hb(ii,atom)=buffer(i,indx+29)
5480 c------------------------------------------------------------------------------
5482 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5483 C This subroutine calculates multi-body contributions to hydrogen-bonding
5484 implicit real*8 (a-h,o-z)
5485 include 'DIMENSIONS'
5486 include 'COMMON.IOUNITS'
5489 parameter (max_cont=maxconts)
5490 parameter (max_dim=2*(8*3+6))
5491 parameter (msglen1=max_cont*max_dim)
5492 parameter (msglen2=2*msglen1)
5493 integer source,CorrelType,CorrelID,Error
5494 double precision buffer(max_cont,max_dim)
5495 integer status(MPI_STATUS_SIZE)
5497 include 'COMMON.SETUP'
5498 include 'COMMON.FFIELD'
5499 include 'COMMON.DERIV'
5500 include 'COMMON.INTERACT'
5501 include 'COMMON.CONTACTS'
5502 include 'COMMON.CONTROL'
5503 double precision gx(3),gx1(3),time00
5506 C Set lprn=.true. for debugging
5511 if (nfgtasks.le.1) goto 30
5513 write (iout,'(a)') 'Contact function values:'
5515 write (iout,'(2i3,50(1x,i2,f5.2))')
5516 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5517 & j=1,num_cont_hb(i))
5520 C Caution! Following code assumes that electrostatic interactions concerning
5521 C a given atom are split among at most two processors!
5531 c write (*,*) 'MyRank',MyRank,' mm',mm
5534 c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5535 if (fg_rank.gt.0) then
5536 C Send correlation contributions to the preceding processor
5538 nn=num_cont_hb(iatel_s)
5539 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5540 c write (*,*) 'The BUFFER array:'
5542 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5544 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5546 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5547 C Clear the contacts of the atom passed to the neighboring processor
5548 nn=num_cont_hb(iatel_s+1)
5550 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5552 num_cont_hb(iatel_s)=0
5554 cd write (iout,*) 'Processor ',fg_rank,MyRank,
5555 cd & ' is sending correlation contribution to processor',fg_rank-1,
5556 cd & ' msglen=',msglen
5557 c write (*,*) 'Processor ',fg_rank,MyRank,
5558 c & ' is sending correlation contribution to processor',fg_rank-1,
5559 c & ' msglen=',msglen,' CorrelType=',CorrelType
5561 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5562 & CorrelType,FG_COMM,IERROR)
5563 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5564 cd write (iout,*) 'Processor ',fg_rank,
5565 cd & ' has sent correlation contribution to processor',fg_rank-1,
5566 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5567 c write (*,*) 'Processor ',fg_rank,
5568 c & ' has sent correlation contribution to processor',fg_rank-1,
5569 c & ' msglen=',msglen,' CorrelID=',CorrelID
5571 endif ! (fg_rank.gt.0)
5575 c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5576 if (fg_rank.lt.nfgtasks-1) then
5577 C Receive correlation contributions from the next processor
5579 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5580 cd write (iout,*) 'Processor',fg_rank,
5581 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5582 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5583 c write (*,*) 'Processor',fg_rank,
5584 c &' is receiving correlation contribution from processor',fg_rank+1,
5585 c & ' msglen=',msglen,' CorrelType=',CorrelType
5588 do while (nbytes.le.0)
5589 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5590 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5592 c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
5593 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5594 & fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5595 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5596 c write (*,*) 'Processor',fg_rank,
5597 c &' has received correlation contribution from processor',fg_rank+1,
5598 c & ' msglen=',msglen,' nbytes=',nbytes
5599 c write (*,*) 'The received BUFFER array:'
5601 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
5603 if (msglen.eq.msglen1) then
5604 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5605 else if (msglen.eq.msglen2) then
5606 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5607 call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5610 & 'ERROR!!!! message length changed while processing correlations.'
5612 & 'ERROR!!!! message length changed while processing correlations.'
5613 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5614 endif ! msglen.eq.msglen1
5615 endif ! fg_rank.lt.nfgtasks-1
5622 write (iout,'(a)') 'Contact function values:'
5624 write (iout,'(2i3,50(1x,i2,f5.2))')
5625 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5626 & j=1,num_cont_hb(i))
5630 C Remove the loop below after debugging !!!
5637 C Calculate the local-electrostatic correlation terms
5638 do i=iatel_s,iatel_e+1
5640 num_conti=num_cont_hb(i)
5641 num_conti1=num_cont_hb(i+1)
5646 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5647 c & ' jj=',jj,' kk=',kk
5648 if (j1.eq.j+1 .or. j1.eq.j-1) then
5649 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5650 C The system gains extra energy.
5651 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5652 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5653 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5655 else if (j1.eq.j) then
5656 C Contacts I-J and I-(J+1) occur simultaneously.
5657 C The system loses extra energy.
5658 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5663 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5664 c & ' jj=',jj,' kk=',kk
5666 C Contacts I-J and (I+1)-J occur simultaneously.
5667 C The system loses extra energy.
5668 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5675 c------------------------------------------------------------------------------
5676 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5678 C This subroutine calculates multi-body contributions to hydrogen-bonding
5679 implicit real*8 (a-h,o-z)
5680 include 'DIMENSIONS'
5681 include 'COMMON.IOUNITS'
5684 parameter (max_cont=maxconts)
5685 parameter (max_dim=2*(8*3+6))
5686 c parameter (msglen1=max_cont*max_dim*4)
5687 parameter (msglen1=max_cont*max_dim/2)
5688 parameter (msglen2=2*msglen1)
5689 integer source,CorrelType,CorrelID,Error
5690 double precision buffer(max_cont,max_dim)
5691 integer status(MPI_STATUS_SIZE)
5693 include 'COMMON.SETUP'
5694 include 'COMMON.FFIELD'
5695 include 'COMMON.DERIV'
5696 include 'COMMON.INTERACT'
5697 include 'COMMON.CONTACTS'
5698 include 'COMMON.CONTROL'
5699 double precision gx(3),gx1(3)
5701 C Set lprn=.true. for debugging
5707 if (fgProcs.le.1) goto 30
5709 write (iout,'(a)') 'Contact function values:'
5711 write (iout,'(2i3,50(1x,i2,f5.2))')
5712 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5713 & j=1,num_cont_hb(i))
5716 C Caution! Following code assumes that electrostatic interactions concerning
5717 C a given atom are split among at most two processors!
5727 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5730 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5731 if (MyRank.gt.0) then
5732 C Send correlation contributions to the preceding processor
5734 nn=num_cont_hb(iatel_s)
5735 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5736 cd write (iout,*) 'The BUFFER array:'
5738 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5740 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5742 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5743 C Clear the contacts of the atom passed to the neighboring processor
5744 nn=num_cont_hb(iatel_s+1)
5746 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5748 num_cont_hb(iatel_s)=0
5750 cd write (*,*) 'Processor ',fg_rank,MyRank,
5751 cd & ' is sending correlation contribution to processor',fg_rank-1,
5752 cd & ' msglen=',msglen
5753 cd write (*,*) 'Processor ',MyID,MyRank,
5754 cd & ' is sending correlation contribution to processor',fg_rank-1,
5755 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5757 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5758 & CorrelType,FG_COMM,IERROR)
5759 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5760 cd write (*,*) 'Processor ',fg_rank,MyRank,
5761 cd & ' has sent correlation contribution to processor',fg_rank-1,
5762 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5763 cd write (*,*) 'Processor ',fg_rank,
5764 cd & ' has sent correlation contribution to processor',fg_rank-1,
5765 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5767 endif ! (MyRank.gt.0)
5771 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5772 if (fg_rank.lt.nfgtasks-1) then
5773 C Receive correlation contributions from the next processor
5775 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5776 cd write (iout,*) 'Processor',fg_rank,
5777 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5778 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5779 cd write (*,*) 'Processor',fg_rank,
5780 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5781 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5784 do while (nbytes.le.0)
5785 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5786 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5788 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5789 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5790 & fg_rank+1,CorrelType,status,IERROR)
5791 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5792 cd write (iout,*) 'Processor',fg_rank,
5793 cd & ' has received correlation contribution from processor',fg_rank+1,
5794 cd & ' msglen=',msglen,' nbytes=',nbytes
5795 cd write (iout,*) 'The received BUFFER array:'
5797 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5799 if (msglen.eq.msglen1) then
5800 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5801 else if (msglen.eq.msglen2) then
5802 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5803 call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5806 & 'ERROR!!!! message length changed while processing correlations.'
5808 & 'ERROR!!!! message length changed while processing correlations.'
5809 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5810 endif ! msglen.eq.msglen1
5811 endif ! fg_rank.lt.nfgtasks-1
5818 write (iout,'(a)') 'Contact function values:'
5820 write (iout,'(2i3,50(1x,i2,f5.2))')
5821 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5822 & j=1,num_cont_hb(i))
5828 C Remove the loop below after debugging !!!
5835 C Calculate the dipole-dipole interaction energies
5836 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5837 do i=iatel_s,iatel_e+1
5838 num_conti=num_cont_hb(i)
5847 C Calculate the local-electrostatic correlation terms
5848 do i=iatel_s,iatel_e+1
5850 num_conti=num_cont_hb(i)
5851 num_conti1=num_cont_hb(i+1)
5856 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5857 c & ' jj=',jj,' kk=',kk
5858 if (j1.eq.j+1 .or. j1.eq.j-1) then
5859 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5860 C The system gains extra energy.
5862 sqd1=dsqrt(d_cont(jj,i))
5863 sqd2=dsqrt(d_cont(kk,i1))
5864 sred_geom = sqd1*sqd2
5865 IF (sred_geom.lt.cutoff_corr) THEN
5866 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5868 cd write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5869 cd & ' jj=',jj,' kk=',kk
5870 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5871 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5873 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5874 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5877 cd write (iout,*) 'sred_geom=',sred_geom,
5878 cd & ' ekont=',ekont,' fprim=',fprimcont
5879 call calc_eello(i,j,i+1,j1,jj,kk)
5880 if (wcorr4.gt.0.0d0)
5881 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5882 if (energy_dec.and.wcorr4.gt.0.0d0)
5883 1 write (iout,'(a6,2i5,0pf7.3)')
5884 2 'ecorr4',i,j,eello4(i,j,i+1,j1,jj,kk)
5885 if (wcorr5.gt.0.0d0)
5886 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5887 if (energy_dec.and.wcorr5.gt.0.0d0)
5888 1 write (iout,'(a6,2i5,0pf7.3)')
5889 2 'ecorr5',i,j,eello5(i,j,i+1,j1,jj,kk)
5890 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5891 cd write(2,*)'ijkl',i,j,i+1,j1
5892 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5893 & .or. wturn6.eq.0.0d0))then
5894 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5895 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5896 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5897 1 'ecorr6',i,j,eello6(i,j,i+1,j1,jj,kk)
5898 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5899 cd & 'ecorr6=',ecorr6
5900 cd write (iout,'(4e15.5)') sred_geom,
5901 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5902 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5903 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5904 else if (wturn6.gt.0.0d0
5905 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5906 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5907 eturn6=eturn6+eello_turn6(i,jj,kk)
5908 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5909 1 'eturn6',i,j,eello_turn6(i,jj,kk)
5910 cd write (2,*) 'multibody_eello:eturn6',eturn6
5914 else if (j1.eq.j) then
5915 C Contacts I-J and I-(J+1) occur simultaneously.
5916 C The system loses extra energy.
5917 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5922 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5923 c & ' jj=',jj,' kk=',kk
5925 C Contacts I-J and (I+1)-J occur simultaneously.
5926 C The system loses extra energy.
5927 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5934 c------------------------------------------------------------------------------
5935 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5936 implicit real*8 (a-h,o-z)
5937 include 'DIMENSIONS'
5938 include 'COMMON.IOUNITS'
5939 include 'COMMON.DERIV'
5940 include 'COMMON.INTERACT'
5941 include 'COMMON.CONTACTS'
5942 double precision gx(3),gx1(3)
5952 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5953 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5954 C Following 4 lines for diagnostics.
5959 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5961 c write (iout,*)'Contacts have occurred for peptide groups',
5962 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5963 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5964 C Calculate the multi-body contribution to energy.
5965 ecorr=ecorr+ekont*ees
5966 C Calculate multi-body contributions to the gradient.
5968 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5969 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5970 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5971 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5972 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5973 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5974 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5975 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5976 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5977 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5978 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5979 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5980 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5981 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5985 gradcorr(ll,m)=gradcorr(ll,m)+
5986 & ees*ekl*gacont_hbr(ll,jj,i)-
5987 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5988 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5993 gradcorr(ll,m)=gradcorr(ll,m)+
5994 & ees*eij*gacont_hbr(ll,kk,k)-
5995 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5996 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6003 C---------------------------------------------------------------------------
6004 subroutine dipole(i,j,jj)
6005 implicit real*8 (a-h,o-z)
6006 include 'DIMENSIONS'
6007 include 'COMMON.IOUNITS'
6008 include 'COMMON.CHAIN'
6009 include 'COMMON.FFIELD'
6010 include 'COMMON.DERIV'
6011 include 'COMMON.INTERACT'
6012 include 'COMMON.CONTACTS'
6013 include 'COMMON.TORSION'
6014 include 'COMMON.VAR'
6015 include 'COMMON.GEO'
6016 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6018 iti1 = itortyp(itype(i+1))
6019 if (j.lt.nres-1) then
6020 itj1 = itortyp(itype(j+1))
6025 dipi(iii,1)=Ub2(iii,i)
6026 dipderi(iii)=Ub2der(iii,i)
6027 dipi(iii,2)=b1(iii,iti1)
6028 dipj(iii,1)=Ub2(iii,j)
6029 dipderj(iii)=Ub2der(iii,j)
6030 dipj(iii,2)=b1(iii,itj1)
6034 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6037 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6044 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6048 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6053 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6054 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6056 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6058 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6060 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6065 C---------------------------------------------------------------------------
6066 subroutine calc_eello(i,j,k,l,jj,kk)
6068 C This subroutine computes matrices and vectors needed to calculate
6069 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6071 implicit real*8 (a-h,o-z)
6072 include 'DIMENSIONS'
6073 include 'COMMON.IOUNITS'
6074 include 'COMMON.CHAIN'
6075 include 'COMMON.DERIV'
6076 include 'COMMON.INTERACT'
6077 include 'COMMON.CONTACTS'
6078 include 'COMMON.TORSION'
6079 include 'COMMON.VAR'
6080 include 'COMMON.GEO'
6081 include 'COMMON.FFIELD'
6082 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6083 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6086 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6087 cd & ' jj=',jj,' kk=',kk
6088 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6091 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6092 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6095 call transpose2(aa1(1,1),aa1t(1,1))
6096 call transpose2(aa2(1,1),aa2t(1,1))
6099 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6100 & aa1tder(1,1,lll,kkk))
6101 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6102 & aa2tder(1,1,lll,kkk))
6106 C parallel orientation of the two CA-CA-CA frames.
6108 iti=itortyp(itype(i))
6112 itk1=itortyp(itype(k+1))
6113 itj=itortyp(itype(j))
6114 if (l.lt.nres-1) then
6115 itl1=itortyp(itype(l+1))
6119 C A1 kernel(j+1) A2T
6121 cd write (iout,'(3f10.5,5x,3f10.5)')
6122 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6124 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6125 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6126 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6127 C Following matrices are needed only for 6-th order cumulants
6128 IF (wcorr6.gt.0.0d0) THEN
6129 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6130 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6131 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6132 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6133 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6134 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6135 & ADtEAderx(1,1,1,1,1,1))
6137 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6138 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6139 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6140 & ADtEA1derx(1,1,1,1,1,1))
6142 C End 6-th order cumulants
6145 cd write (2,*) 'In calc_eello6'
6147 cd write (2,*) 'iii=',iii
6149 cd write (2,*) 'kkk=',kkk
6151 cd write (2,'(3(2f10.5),5x)')
6152 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6157 call transpose2(EUgder(1,1,k),auxmat(1,1))
6158 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6159 call transpose2(EUg(1,1,k),auxmat(1,1))
6160 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6161 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6165 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6166 & EAEAderx(1,1,lll,kkk,iii,1))
6170 C A1T kernel(i+1) A2
6171 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6172 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6173 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6174 C Following matrices are needed only for 6-th order cumulants
6175 IF (wcorr6.gt.0.0d0) THEN
6176 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6177 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6178 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6179 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6180 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6181 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6182 & ADtEAderx(1,1,1,1,1,2))
6183 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6184 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6185 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6186 & ADtEA1derx(1,1,1,1,1,2))
6188 C End 6-th order cumulants
6189 call transpose2(EUgder(1,1,l),auxmat(1,1))
6190 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6191 call transpose2(EUg(1,1,l),auxmat(1,1))
6192 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6193 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6197 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6198 & EAEAderx(1,1,lll,kkk,iii,2))
6203 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6204 C They are needed only when the fifth- or the sixth-order cumulants are
6206 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6207 call transpose2(AEA(1,1,1),auxmat(1,1))
6208 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6209 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6210 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6211 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6212 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6213 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6214 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6215 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6216 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6217 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6218 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6219 call transpose2(AEA(1,1,2),auxmat(1,1))
6220 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6221 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6222 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6223 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6224 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6225 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6226 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6227 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6228 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6229 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6230 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6231 C Calculate the Cartesian derivatives of the vectors.
6235 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6236 call matvec2(auxmat(1,1),b1(1,iti),
6237 & AEAb1derx(1,lll,kkk,iii,1,1))
6238 call matvec2(auxmat(1,1),Ub2(1,i),
6239 & AEAb2derx(1,lll,kkk,iii,1,1))
6240 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6241 & AEAb1derx(1,lll,kkk,iii,2,1))
6242 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6243 & AEAb2derx(1,lll,kkk,iii,2,1))
6244 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6245 call matvec2(auxmat(1,1),b1(1,itj),
6246 & AEAb1derx(1,lll,kkk,iii,1,2))
6247 call matvec2(auxmat(1,1),Ub2(1,j),
6248 & AEAb2derx(1,lll,kkk,iii,1,2))
6249 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6250 & AEAb1derx(1,lll,kkk,iii,2,2))
6251 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6252 & AEAb2derx(1,lll,kkk,iii,2,2))
6259 C Antiparallel orientation of the two CA-CA-CA frames.
6261 iti=itortyp(itype(i))
6265 itk1=itortyp(itype(k+1))
6266 itl=itortyp(itype(l))
6267 itj=itortyp(itype(j))
6268 if (j.lt.nres-1) then
6269 itj1=itortyp(itype(j+1))
6273 C A2 kernel(j-1)T A1T
6274 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6275 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6276 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6277 C Following matrices are needed only for 6-th order cumulants
6278 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6279 & j.eq.i+4 .and. l.eq.i+3)) THEN
6280 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6281 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6282 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6283 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6284 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6285 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6286 & ADtEAderx(1,1,1,1,1,1))
6287 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6288 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6289 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6290 & ADtEA1derx(1,1,1,1,1,1))
6292 C End 6-th order cumulants
6293 call transpose2(EUgder(1,1,k),auxmat(1,1))
6294 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6295 call transpose2(EUg(1,1,k),auxmat(1,1))
6296 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6297 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6301 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6302 & EAEAderx(1,1,lll,kkk,iii,1))
6306 C A2T kernel(i+1)T A1
6307 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6308 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6309 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6310 C Following matrices are needed only for 6-th order cumulants
6311 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6312 & j.eq.i+4 .and. l.eq.i+3)) THEN
6313 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6314 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6315 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6316 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6317 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6318 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6319 & ADtEAderx(1,1,1,1,1,2))
6320 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6321 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6322 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6323 & ADtEA1derx(1,1,1,1,1,2))
6325 C End 6-th order cumulants
6326 call transpose2(EUgder(1,1,j),auxmat(1,1))
6327 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6328 call transpose2(EUg(1,1,j),auxmat(1,1))
6329 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6330 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6334 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6335 & EAEAderx(1,1,lll,kkk,iii,2))
6340 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6341 C They are needed only when the fifth- or the sixth-order cumulants are
6343 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6344 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6345 call transpose2(AEA(1,1,1),auxmat(1,1))
6346 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6347 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6348 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6349 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6350 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6351 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6352 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6353 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6354 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6355 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6356 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6357 call transpose2(AEA(1,1,2),auxmat(1,1))
6358 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6359 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6360 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6361 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6362 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6363 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6364 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6365 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6366 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6367 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6368 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6369 C Calculate the Cartesian derivatives of the vectors.
6373 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6374 call matvec2(auxmat(1,1),b1(1,iti),
6375 & AEAb1derx(1,lll,kkk,iii,1,1))
6376 call matvec2(auxmat(1,1),Ub2(1,i),
6377 & AEAb2derx(1,lll,kkk,iii,1,1))
6378 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6379 & AEAb1derx(1,lll,kkk,iii,2,1))
6380 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6381 & AEAb2derx(1,lll,kkk,iii,2,1))
6382 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6383 call matvec2(auxmat(1,1),b1(1,itl),
6384 & AEAb1derx(1,lll,kkk,iii,1,2))
6385 call matvec2(auxmat(1,1),Ub2(1,l),
6386 & AEAb2derx(1,lll,kkk,iii,1,2))
6387 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6388 & AEAb1derx(1,lll,kkk,iii,2,2))
6389 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6390 & AEAb2derx(1,lll,kkk,iii,2,2))
6399 C---------------------------------------------------------------------------
6400 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6401 & KK,KKderg,AKA,AKAderg,AKAderx)
6405 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6406 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6407 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6412 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6414 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6417 cd if (lprn) write (2,*) 'In kernel'
6419 cd if (lprn) write (2,*) 'kkk=',kkk
6421 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6422 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6424 cd write (2,*) 'lll=',lll
6425 cd write (2,*) 'iii=1'
6427 cd write (2,'(3(2f10.5),5x)')
6428 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6431 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6432 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6434 cd write (2,*) 'lll=',lll
6435 cd write (2,*) 'iii=2'
6437 cd write (2,'(3(2f10.5),5x)')
6438 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6445 C---------------------------------------------------------------------------
6446 double precision function eello4(i,j,k,l,jj,kk)
6447 implicit real*8 (a-h,o-z)
6448 include 'DIMENSIONS'
6449 include 'COMMON.IOUNITS'
6450 include 'COMMON.CHAIN'
6451 include 'COMMON.DERIV'
6452 include 'COMMON.INTERACT'
6453 include 'COMMON.CONTACTS'
6454 include 'COMMON.TORSION'
6455 include 'COMMON.VAR'
6456 include 'COMMON.GEO'
6457 double precision pizda(2,2),ggg1(3),ggg2(3)
6458 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6462 cd print *,'eello4:',i,j,k,l,jj,kk
6463 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6464 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6465 cold eij=facont_hb(jj,i)
6466 cold ekl=facont_hb(kk,k)
6468 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6469 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6470 gcorr_loc(k-1)=gcorr_loc(k-1)
6471 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6473 gcorr_loc(l-1)=gcorr_loc(l-1)
6474 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6476 gcorr_loc(j-1)=gcorr_loc(j-1)
6477 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6482 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6483 & -EAEAderx(2,2,lll,kkk,iii,1)
6484 cd derx(lll,kkk,iii)=0.0d0
6488 cd gcorr_loc(l-1)=0.0d0
6489 cd gcorr_loc(j-1)=0.0d0
6490 cd gcorr_loc(k-1)=0.0d0
6492 cd write (iout,*)'Contacts have occurred for peptide groups',
6493 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6494 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6495 if (j.lt.nres-1) then
6502 if (l.lt.nres-1) then
6510 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6511 ggg1(ll)=eel4*g_contij(ll,1)
6512 ggg2(ll)=eel4*g_contij(ll,2)
6513 ghalf=0.5d0*ggg1(ll)
6515 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6516 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6517 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6518 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6519 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6520 ghalf=0.5d0*ggg2(ll)
6522 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6523 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6524 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6525 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6530 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6531 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6536 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6537 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6543 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6548 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6552 cd write (2,*) iii,gcorr_loc(iii)
6555 cd write (2,*) 'ekont',ekont
6556 cd write (iout,*) 'eello4',ekont*eel4
6559 C---------------------------------------------------------------------------
6560 double precision function eello5(i,j,k,l,jj,kk)
6561 implicit real*8 (a-h,o-z)
6562 include 'DIMENSIONS'
6563 include 'COMMON.IOUNITS'
6564 include 'COMMON.CHAIN'
6565 include 'COMMON.DERIV'
6566 include 'COMMON.INTERACT'
6567 include 'COMMON.CONTACTS'
6568 include 'COMMON.TORSION'
6569 include 'COMMON.VAR'
6570 include 'COMMON.GEO'
6571 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6572 double precision ggg1(3),ggg2(3)
6573 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6578 C /l\ / \ \ / \ / \ / C
6579 C / \ / \ \ / \ / \ / C
6580 C j| o |l1 | o | o| o | | o |o C
6581 C \ |/k\| |/ \| / |/ \| |/ \| C
6582 C \i/ \ / \ / / \ / \ C
6584 C (I) (II) (III) (IV) C
6586 C eello5_1 eello5_2 eello5_3 eello5_4 C
6588 C Antiparallel chains C
6591 C /j\ / \ \ / \ / \ / C
6592 C / \ / \ \ / \ / \ / C
6593 C j1| o |l | o | o| o | | o |o C
6594 C \ |/k\| |/ \| / |/ \| |/ \| C
6595 C \i/ \ / \ / / \ / \ C
6597 C (I) (II) (III) (IV) C
6599 C eello5_1 eello5_2 eello5_3 eello5_4 C
6601 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6603 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6604 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6609 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6611 itk=itortyp(itype(k))
6612 itl=itortyp(itype(l))
6613 itj=itortyp(itype(j))
6618 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6619 cd & eel5_3_num,eel5_4_num)
6623 derx(lll,kkk,iii)=0.0d0
6627 cd eij=facont_hb(jj,i)
6628 cd ekl=facont_hb(kk,k)
6630 cd write (iout,*)'Contacts have occurred for peptide groups',
6631 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6633 C Contribution from the graph I.
6634 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6635 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6636 call transpose2(EUg(1,1,k),auxmat(1,1))
6637 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6638 vv(1)=pizda(1,1)-pizda(2,2)
6639 vv(2)=pizda(1,2)+pizda(2,1)
6640 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6641 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6642 C Explicit gradient in virtual-dihedral angles.
6643 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6644 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6645 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6646 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6647 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6648 vv(1)=pizda(1,1)-pizda(2,2)
6649 vv(2)=pizda(1,2)+pizda(2,1)
6650 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6651 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6652 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6653 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6654 vv(1)=pizda(1,1)-pizda(2,2)
6655 vv(2)=pizda(1,2)+pizda(2,1)
6657 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6658 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6659 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6661 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6662 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6663 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6665 C Cartesian gradient
6669 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6671 vv(1)=pizda(1,1)-pizda(2,2)
6672 vv(2)=pizda(1,2)+pizda(2,1)
6673 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6674 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6675 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6681 C Contribution from graph II
6682 call transpose2(EE(1,1,itk),auxmat(1,1))
6683 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6684 vv(1)=pizda(1,1)+pizda(2,2)
6685 vv(2)=pizda(2,1)-pizda(1,2)
6686 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6687 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6688 C Explicit gradient in virtual-dihedral angles.
6689 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6690 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6691 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6692 vv(1)=pizda(1,1)+pizda(2,2)
6693 vv(2)=pizda(2,1)-pizda(1,2)
6695 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6696 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6697 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6699 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6700 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6701 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6703 C Cartesian gradient
6707 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6709 vv(1)=pizda(1,1)+pizda(2,2)
6710 vv(2)=pizda(2,1)-pizda(1,2)
6711 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6712 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6713 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6721 C Parallel orientation
6722 C Contribution from graph III
6723 call transpose2(EUg(1,1,l),auxmat(1,1))
6724 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6725 vv(1)=pizda(1,1)-pizda(2,2)
6726 vv(2)=pizda(1,2)+pizda(2,1)
6727 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6728 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6729 C Explicit gradient in virtual-dihedral angles.
6730 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6731 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6732 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6733 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6734 vv(1)=pizda(1,1)-pizda(2,2)
6735 vv(2)=pizda(1,2)+pizda(2,1)
6736 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6737 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6738 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6739 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6740 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6741 vv(1)=pizda(1,1)-pizda(2,2)
6742 vv(2)=pizda(1,2)+pizda(2,1)
6743 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6744 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6745 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6746 C Cartesian gradient
6750 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6752 vv(1)=pizda(1,1)-pizda(2,2)
6753 vv(2)=pizda(1,2)+pizda(2,1)
6754 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6755 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6756 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6761 C Contribution from graph IV
6763 call transpose2(EE(1,1,itl),auxmat(1,1))
6764 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6765 vv(1)=pizda(1,1)+pizda(2,2)
6766 vv(2)=pizda(2,1)-pizda(1,2)
6767 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6768 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6769 C Explicit gradient in virtual-dihedral angles.
6770 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6771 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6772 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6773 vv(1)=pizda(1,1)+pizda(2,2)
6774 vv(2)=pizda(2,1)-pizda(1,2)
6775 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6776 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6777 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6778 C Cartesian gradient
6782 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6784 vv(1)=pizda(1,1)+pizda(2,2)
6785 vv(2)=pizda(2,1)-pizda(1,2)
6786 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6787 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6788 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6793 C Antiparallel orientation
6794 C Contribution from graph III
6796 call transpose2(EUg(1,1,j),auxmat(1,1))
6797 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6798 vv(1)=pizda(1,1)-pizda(2,2)
6799 vv(2)=pizda(1,2)+pizda(2,1)
6800 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6801 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6802 C Explicit gradient in virtual-dihedral angles.
6803 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6804 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6805 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6806 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6807 vv(1)=pizda(1,1)-pizda(2,2)
6808 vv(2)=pizda(1,2)+pizda(2,1)
6809 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6810 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6811 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6812 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6813 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6814 vv(1)=pizda(1,1)-pizda(2,2)
6815 vv(2)=pizda(1,2)+pizda(2,1)
6816 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6817 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6818 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6819 C Cartesian gradient
6823 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6825 vv(1)=pizda(1,1)-pizda(2,2)
6826 vv(2)=pizda(1,2)+pizda(2,1)
6827 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6828 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6829 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6834 C Contribution from graph IV
6836 call transpose2(EE(1,1,itj),auxmat(1,1))
6837 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6838 vv(1)=pizda(1,1)+pizda(2,2)
6839 vv(2)=pizda(2,1)-pizda(1,2)
6840 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6841 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6842 C Explicit gradient in virtual-dihedral angles.
6843 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6844 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6845 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6846 vv(1)=pizda(1,1)+pizda(2,2)
6847 vv(2)=pizda(2,1)-pizda(1,2)
6848 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6849 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6850 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6851 C Cartesian gradient
6855 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6857 vv(1)=pizda(1,1)+pizda(2,2)
6858 vv(2)=pizda(2,1)-pizda(1,2)
6859 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6860 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6861 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6867 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6868 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6869 cd write (2,*) 'ijkl',i,j,k,l
6870 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6871 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6873 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6874 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6875 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6876 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6877 if (j.lt.nres-1) then
6884 if (l.lt.nres-1) then
6894 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6896 ggg1(ll)=eel5*g_contij(ll,1)
6897 ggg2(ll)=eel5*g_contij(ll,2)
6898 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6899 ghalf=0.5d0*ggg1(ll)
6901 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6902 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6903 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6904 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6905 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6906 ghalf=0.5d0*ggg2(ll)
6908 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6909 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6910 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6911 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6916 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6917 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6922 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6923 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6929 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6934 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6938 cd write (2,*) iii,g_corr5_loc(iii)
6941 cd write (2,*) 'ekont',ekont
6942 cd write (iout,*) 'eello5',ekont*eel5
6945 c--------------------------------------------------------------------------
6946 double precision function eello6(i,j,k,l,jj,kk)
6947 implicit real*8 (a-h,o-z)
6948 include 'DIMENSIONS'
6949 include 'COMMON.IOUNITS'
6950 include 'COMMON.CHAIN'
6951 include 'COMMON.DERIV'
6952 include 'COMMON.INTERACT'
6953 include 'COMMON.CONTACTS'
6954 include 'COMMON.TORSION'
6955 include 'COMMON.VAR'
6956 include 'COMMON.GEO'
6957 include 'COMMON.FFIELD'
6958 double precision ggg1(3),ggg2(3)
6959 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6964 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6972 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6973 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6977 derx(lll,kkk,iii)=0.0d0
6981 cd eij=facont_hb(jj,i)
6982 cd ekl=facont_hb(kk,k)
6988 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6989 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6990 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6991 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6992 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6993 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6995 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6996 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6997 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6998 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6999 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7000 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7004 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7006 C If turn contributions are considered, they will be handled separately.
7007 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7008 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7009 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7010 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7011 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7012 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7013 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7015 if (j.lt.nres-1) then
7022 if (l.lt.nres-1) then
7030 ggg1(ll)=eel6*g_contij(ll,1)
7031 ggg2(ll)=eel6*g_contij(ll,2)
7032 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7033 ghalf=0.5d0*ggg1(ll)
7035 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7036 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7037 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7038 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7039 ghalf=0.5d0*ggg2(ll)
7040 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7042 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7043 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7044 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7045 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7050 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7051 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7056 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7057 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7063 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7068 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7072 cd write (2,*) iii,g_corr6_loc(iii)
7075 cd write (2,*) 'ekont',ekont
7076 cd write (iout,*) 'eello6',ekont*eel6
7079 c--------------------------------------------------------------------------
7080 double precision function eello6_graph1(i,j,k,l,imat,swap)
7081 implicit real*8 (a-h,o-z)
7082 include 'DIMENSIONS'
7083 include 'COMMON.IOUNITS'
7084 include 'COMMON.CHAIN'
7085 include 'COMMON.DERIV'
7086 include 'COMMON.INTERACT'
7087 include 'COMMON.CONTACTS'
7088 include 'COMMON.TORSION'
7089 include 'COMMON.VAR'
7090 include 'COMMON.GEO'
7091 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7095 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7097 C Parallel Antiparallel
7103 C \ j|/k\| / \ |/k\|l /
7108 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7109 itk=itortyp(itype(k))
7110 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7111 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7112 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7113 call transpose2(EUgC(1,1,k),auxmat(1,1))
7114 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7115 vv1(1)=pizda1(1,1)-pizda1(2,2)
7116 vv1(2)=pizda1(1,2)+pizda1(2,1)
7117 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7118 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7119 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7120 s5=scalar2(vv(1),Dtobr2(1,i))
7121 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7122 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7123 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7124 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7125 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7126 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7127 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7128 & +scalar2(vv(1),Dtobr2der(1,i)))
7129 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7130 vv1(1)=pizda1(1,1)-pizda1(2,2)
7131 vv1(2)=pizda1(1,2)+pizda1(2,1)
7132 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7133 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7135 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7136 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7137 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7138 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7139 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7141 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7142 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7143 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7144 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7145 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7147 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7148 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7149 vv1(1)=pizda1(1,1)-pizda1(2,2)
7150 vv1(2)=pizda1(1,2)+pizda1(2,1)
7151 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7152 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7153 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7154 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7163 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7164 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7165 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7166 call transpose2(EUgC(1,1,k),auxmat(1,1))
7167 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7169 vv1(1)=pizda1(1,1)-pizda1(2,2)
7170 vv1(2)=pizda1(1,2)+pizda1(2,1)
7171 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7172 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7173 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7174 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7175 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7176 s5=scalar2(vv(1),Dtobr2(1,i))
7177 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7183 c----------------------------------------------------------------------------
7184 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7185 implicit real*8 (a-h,o-z)
7186 include 'DIMENSIONS'
7187 include 'COMMON.IOUNITS'
7188 include 'COMMON.CHAIN'
7189 include 'COMMON.DERIV'
7190 include 'COMMON.INTERACT'
7191 include 'COMMON.CONTACTS'
7192 include 'COMMON.TORSION'
7193 include 'COMMON.VAR'
7194 include 'COMMON.GEO'
7196 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7197 & auxvec1(2),auxvec2(1),auxmat1(2,2)
7200 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7202 C Parallel Antiparallel
7213 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7214 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7215 C AL 7/4/01 s1 would occur in the sixth-order moment,
7216 C but not in a cluster cumulant
7218 s1=dip(1,jj,i)*dip(1,kk,k)
7220 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7221 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7222 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7223 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7224 call transpose2(EUg(1,1,k),auxmat(1,1))
7225 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7226 vv(1)=pizda(1,1)-pizda(2,2)
7227 vv(2)=pizda(1,2)+pizda(2,1)
7228 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7229 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7231 eello6_graph2=-(s1+s2+s3+s4)
7233 eello6_graph2=-(s2+s3+s4)
7236 C Derivatives in gamma(i-1)
7239 s1=dipderg(1,jj,i)*dip(1,kk,k)
7241 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7242 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7243 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7244 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7246 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7248 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7250 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7252 C Derivatives in gamma(k-1)
7254 s1=dip(1,jj,i)*dipderg(1,kk,k)
7256 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7257 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7258 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7259 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7260 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7261 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7262 vv(1)=pizda(1,1)-pizda(2,2)
7263 vv(2)=pizda(1,2)+pizda(2,1)
7264 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7266 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7268 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7270 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7271 C Derivatives in gamma(j-1) or gamma(l-1)
7274 s1=dipderg(3,jj,i)*dip(1,kk,k)
7276 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7277 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7278 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7279 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7280 vv(1)=pizda(1,1)-pizda(2,2)
7281 vv(2)=pizda(1,2)+pizda(2,1)
7282 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7285 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7287 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7290 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7291 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7293 C Derivatives in gamma(l-1) or gamma(j-1)
7296 s1=dip(1,jj,i)*dipderg(3,kk,k)
7298 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7299 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7300 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7301 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7302 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7303 vv(1)=pizda(1,1)-pizda(2,2)
7304 vv(2)=pizda(1,2)+pizda(2,1)
7305 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7308 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7310 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7313 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7314 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7316 C Cartesian derivatives.
7318 write (2,*) 'In eello6_graph2'
7320 write (2,*) 'iii=',iii
7322 write (2,*) 'kkk=',kkk
7324 write (2,'(3(2f10.5),5x)')
7325 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7335 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7337 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7340 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7342 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7343 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7345 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7346 call transpose2(EUg(1,1,k),auxmat(1,1))
7347 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7349 vv(1)=pizda(1,1)-pizda(2,2)
7350 vv(2)=pizda(1,2)+pizda(2,1)
7351 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7352 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7354 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7356 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7359 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7361 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7368 c----------------------------------------------------------------------------
7369 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7370 implicit real*8 (a-h,o-z)
7371 include 'DIMENSIONS'
7372 include 'COMMON.IOUNITS'
7373 include 'COMMON.CHAIN'
7374 include 'COMMON.DERIV'
7375 include 'COMMON.INTERACT'
7376 include 'COMMON.CONTACTS'
7377 include 'COMMON.TORSION'
7378 include 'COMMON.VAR'
7379 include 'COMMON.GEO'
7380 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7382 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7384 C Parallel Antiparallel
7395 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7397 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7398 C energy moment and not to the cluster cumulant.
7399 iti=itortyp(itype(i))
7400 if (j.lt.nres-1) then
7401 itj1=itortyp(itype(j+1))
7405 itk=itortyp(itype(k))
7406 itk1=itortyp(itype(k+1))
7407 if (l.lt.nres-1) then
7408 itl1=itortyp(itype(l+1))
7413 s1=dip(4,jj,i)*dip(4,kk,k)
7415 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7416 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7417 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7418 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7419 call transpose2(EE(1,1,itk),auxmat(1,1))
7420 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7421 vv(1)=pizda(1,1)+pizda(2,2)
7422 vv(2)=pizda(2,1)-pizda(1,2)
7423 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7424 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7426 eello6_graph3=-(s1+s2+s3+s4)
7428 eello6_graph3=-(s2+s3+s4)
7431 C Derivatives in gamma(k-1)
7432 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7433 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7434 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7435 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7436 C Derivatives in gamma(l-1)
7437 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7438 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7439 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7440 vv(1)=pizda(1,1)+pizda(2,2)
7441 vv(2)=pizda(2,1)-pizda(1,2)
7442 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7443 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7444 C Cartesian derivatives.
7450 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7452 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7455 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7457 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7458 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7460 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7461 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7463 vv(1)=pizda(1,1)+pizda(2,2)
7464 vv(2)=pizda(2,1)-pizda(1,2)
7465 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7467 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7469 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7472 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7474 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7476 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7482 c----------------------------------------------------------------------------
7483 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7484 implicit real*8 (a-h,o-z)
7485 include 'DIMENSIONS'
7486 include 'COMMON.IOUNITS'
7487 include 'COMMON.CHAIN'
7488 include 'COMMON.DERIV'
7489 include 'COMMON.INTERACT'
7490 include 'COMMON.CONTACTS'
7491 include 'COMMON.TORSION'
7492 include 'COMMON.VAR'
7493 include 'COMMON.GEO'
7494 include 'COMMON.FFIELD'
7495 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7496 & auxvec1(2),auxmat1(2,2)
7498 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7500 C Parallel Antiparallel
7511 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7513 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7514 C energy moment and not to the cluster cumulant.
7515 cd write (2,*) 'eello_graph4: wturn6',wturn6
7516 iti=itortyp(itype(i))
7517 itj=itortyp(itype(j))
7518 if (j.lt.nres-1) then
7519 itj1=itortyp(itype(j+1))
7523 itk=itortyp(itype(k))
7524 if (k.lt.nres-1) then
7525 itk1=itortyp(itype(k+1))
7529 itl=itortyp(itype(l))
7530 if (l.lt.nres-1) then
7531 itl1=itortyp(itype(l+1))
7535 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7536 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7537 cd & ' itl',itl,' itl1',itl1
7540 s1=dip(3,jj,i)*dip(3,kk,k)
7542 s1=dip(2,jj,j)*dip(2,kk,l)
7545 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7546 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7548 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7549 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7551 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7552 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7554 call transpose2(EUg(1,1,k),auxmat(1,1))
7555 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7556 vv(1)=pizda(1,1)-pizda(2,2)
7557 vv(2)=pizda(2,1)+pizda(1,2)
7558 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7559 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7561 eello6_graph4=-(s1+s2+s3+s4)
7563 eello6_graph4=-(s2+s3+s4)
7565 C Derivatives in gamma(i-1)
7569 s1=dipderg(2,jj,i)*dip(3,kk,k)
7571 s1=dipderg(4,jj,j)*dip(2,kk,l)
7574 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7576 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7577 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7579 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7580 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7582 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7583 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7584 cd write (2,*) 'turn6 derivatives'
7586 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7588 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7592 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7594 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7598 C Derivatives in gamma(k-1)
7601 s1=dip(3,jj,i)*dipderg(2,kk,k)
7603 s1=dip(2,jj,j)*dipderg(4,kk,l)
7606 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7607 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7609 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7610 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7612 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7613 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7615 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7616 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7617 vv(1)=pizda(1,1)-pizda(2,2)
7618 vv(2)=pizda(2,1)+pizda(1,2)
7619 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7620 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7622 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7624 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7628 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7630 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7633 C Derivatives in gamma(j-1) or gamma(l-1)
7634 if (l.eq.j+1 .and. l.gt.1) then
7635 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7636 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7637 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7638 vv(1)=pizda(1,1)-pizda(2,2)
7639 vv(2)=pizda(2,1)+pizda(1,2)
7640 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7641 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7642 else if (j.gt.1) then
7643 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7644 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7645 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7646 vv(1)=pizda(1,1)-pizda(2,2)
7647 vv(2)=pizda(2,1)+pizda(1,2)
7648 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7649 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7650 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7652 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7655 C Cartesian derivatives.
7662 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7664 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7668 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7670 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7674 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7676 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7678 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7679 & b1(1,itj1),auxvec(1))
7680 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7682 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7683 & b1(1,itl1),auxvec(1))
7684 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7686 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7688 vv(1)=pizda(1,1)-pizda(2,2)
7689 vv(2)=pizda(2,1)+pizda(1,2)
7690 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7692 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7694 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7697 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7700 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7703 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7705 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7707 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7711 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7713 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7716 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7718 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7726 c----------------------------------------------------------------------------
7727 double precision function eello_turn6(i,jj,kk)
7728 implicit real*8 (a-h,o-z)
7729 include 'DIMENSIONS'
7730 include 'COMMON.IOUNITS'
7731 include 'COMMON.CHAIN'
7732 include 'COMMON.DERIV'
7733 include 'COMMON.INTERACT'
7734 include 'COMMON.CONTACTS'
7735 include 'COMMON.TORSION'
7736 include 'COMMON.VAR'
7737 include 'COMMON.GEO'
7738 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7739 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7741 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7742 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7743 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7744 C the respective energy moment and not to the cluster cumulant.
7753 iti=itortyp(itype(i))
7754 itk=itortyp(itype(k))
7755 itk1=itortyp(itype(k+1))
7756 itl=itortyp(itype(l))
7757 itj=itortyp(itype(j))
7758 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7759 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7760 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7765 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7767 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7771 derx_turn(lll,kkk,iii)=0.0d0
7778 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7780 cd write (2,*) 'eello6_5',eello6_5
7782 call transpose2(AEA(1,1,1),auxmat(1,1))
7783 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7784 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7785 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7787 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7788 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7789 s2 = scalar2(b1(1,itk),vtemp1(1))
7791 call transpose2(AEA(1,1,2),atemp(1,1))
7792 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7793 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7794 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7796 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7797 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7798 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7800 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7801 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7802 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7803 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7804 ss13 = scalar2(b1(1,itk),vtemp4(1))
7805 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7807 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7813 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7814 C Derivatives in gamma(i+2)
7818 call transpose2(AEA(1,1,1),auxmatd(1,1))
7819 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7820 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7821 call transpose2(AEAderg(1,1,2),atempd(1,1))
7822 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7823 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7825 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7826 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7827 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7833 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7834 C Derivatives in gamma(i+3)
7836 call transpose2(AEA(1,1,1),auxmatd(1,1))
7837 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7838 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7839 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7841 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7842 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7843 s2d = scalar2(b1(1,itk),vtemp1d(1))
7845 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7846 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7848 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7850 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7851 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7852 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7860 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7861 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7863 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7864 & -0.5d0*ekont*(s2d+s12d)
7866 C Derivatives in gamma(i+4)
7867 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7868 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7869 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7871 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7872 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7873 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7881 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7883 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7885 C Derivatives in gamma(i+5)
7887 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7888 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7889 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7891 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7892 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7893 s2d = scalar2(b1(1,itk),vtemp1d(1))
7895 call transpose2(AEA(1,1,2),atempd(1,1))
7896 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7897 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7899 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7900 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7902 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7903 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7904 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7912 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7913 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7915 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7916 & -0.5d0*ekont*(s2d+s12d)
7918 C Cartesian derivatives
7923 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7924 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7925 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7927 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7928 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7930 s2d = scalar2(b1(1,itk),vtemp1d(1))
7932 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7933 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7934 s8d = -(atempd(1,1)+atempd(2,2))*
7935 & scalar2(cc(1,1,itl),vtemp2(1))
7937 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7939 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7940 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7947 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7950 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7954 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7955 & - 0.5d0*(s8d+s12d)
7957 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7966 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7968 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7969 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7970 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7971 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7972 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7974 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7975 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7976 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7980 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7981 cd & 16*eel_turn6_num
7983 if (j.lt.nres-1) then
7990 if (l.lt.nres-1) then
7998 ggg1(ll)=eel_turn6*g_contij(ll,1)
7999 ggg2(ll)=eel_turn6*g_contij(ll,2)
8000 ghalf=0.5d0*ggg1(ll)
8002 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8003 & +ekont*derx_turn(ll,2,1)
8004 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8005 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8006 & +ekont*derx_turn(ll,4,1)
8007 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8008 ghalf=0.5d0*ggg2(ll)
8010 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8011 & +ekont*derx_turn(ll,2,2)
8012 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8013 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8014 & +ekont*derx_turn(ll,4,2)
8015 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8020 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8025 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8031 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8036 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8040 cd write (2,*) iii,g_corr6_loc(iii)
8042 eello_turn6=ekont*eel_turn6
8043 cd write (2,*) 'ekont',ekont
8044 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8048 C-----------------------------------------------------------------------------
8049 double precision function scalar(u,v)
8050 !DIR$ INLINEALWAYS scalar
8052 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8055 double precision u(3),v(3)
8056 cd double precision sc
8064 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8067 crc-------------------------------------------------
8068 SUBROUTINE MATVEC2(A1,V1,V2)
8069 !DIR$ INLINEALWAYS MATVEC2
8071 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8073 implicit real*8 (a-h,o-z)
8074 include 'DIMENSIONS'
8075 DIMENSION A1(2,2),V1(2),V2(2)
8079 c 3 VI=VI+A1(I,K)*V1(K)
8083 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8084 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8089 C---------------------------------------
8090 SUBROUTINE MATMAT2(A1,A2,A3)
8092 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8094 implicit real*8 (a-h,o-z)
8095 include 'DIMENSIONS'
8096 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8097 c DIMENSION AI3(2,2)
8101 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8107 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8108 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8109 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8110 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8118 c-------------------------------------------------------------------------
8119 double precision function scalar2(u,v)
8120 !DIR$ INLINEALWAYS scalar2
8122 double precision u(2),v(2)
8125 scalar2=u(1)*v(1)+u(2)*v(2)
8129 C-----------------------------------------------------------------------------
8131 subroutine transpose2(a,at)
8132 !DIR$ INLINEALWAYS transpose2
8134 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8137 double precision a(2,2),at(2,2)
8144 c--------------------------------------------------------------------------
8145 subroutine transpose(n,a,at)
8148 double precision a(n,n),at(n,n)
8156 C---------------------------------------------------------------------------
8157 subroutine prodmat3(a1,a2,kk,transp,prod)
8158 !DIR$ INLINEALWAYS prodmat3
8160 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8164 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8166 crc double precision auxmat(2,2),prod_(2,2)
8169 crc call transpose2(kk(1,1),auxmat(1,1))
8170 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8171 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8173 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8174 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8175 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8176 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8177 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8178 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8179 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8180 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8183 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8184 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8186 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8187 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8188 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8189 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8190 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8191 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8192 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8193 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8196 c call transpose2(a2(1,1),a2t(1,1))
8199 crc print *,((prod_(i,j),i=1,2),j=1,2)
8200 crc print *,((prod(i,j),i=1,2),j=1,2)