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'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 c call chainbuild_cart
87 c print *,'Processor',myrank,' calling etotal ipot=',ipot
88 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
90 c if (modecalc.eq.12.or.modecalc.eq.14) then
91 c call int_from_cart1(.false.)
95 C Compute the side-chain and electrostatic interaction energy
97 goto (101,102,103,104,105,106) ipot
98 C Lennard-Jones potential.
100 cd print '(a)','Exit ELJ'
102 C Lennard-Jones-Kihara potential (shifted).
105 C Berne-Pechukas potential (dilated LJ, angular dependence).
108 C Gay-Berne potential (shifted LJ, angular dependence).
111 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
114 C Soft-sphere potential
115 106 call e_softsphere(evdw)
117 C Calculate electrostatic (H-bonding) energy of the main chain.
120 c print *,"Processor",myrank," computed USCSC"
122 c print *,"Processor",myrank," left VEC_AND_DERIV"
125 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
126 & wturn3.gt.0d0.or.wturn4.gt.0d0) then
128 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
129 & wturn3.gt.0d0.or.wturn4.gt.0d0) then
131 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
140 c write (iout,*) "Soft-spheer ELEC potential"
141 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
144 c print *,"Processor",myrank," computed UELEC"
146 C Calculate excluded-volume interaction energy between peptide groups
151 call escp(evdw2,evdw2_14)
157 c write (iout,*) "Soft-sphere SCP potential"
158 call escp_soft_sphere(evdw2,evdw2_14)
161 c Calculate the bond-stretching energy
165 C Calculate the disulfide-bridge and other energy and the contributions
166 C from other distance constraints.
167 cd print *,'Calling EHPB'
169 cd print *,'EHPB exitted succesfully.'
171 C Calculate the virtual-bond-angle energy.
173 if (wang.gt.0d0) then
178 c print *,"Processor",myrank," computed UB"
180 C Calculate the SC local energy.
183 c print *,"Processor",myrank," computed USC"
185 C Calculate the virtual-bond torsional energy.
187 cd print *,'nterm=',nterm
189 call etor(etors,edihcnstr)
194 c print *,"Processor",myrank," computed Utor"
196 C 6/23/01 Calculate double-torsional energy
198 if (wtor_d.gt.0) then
203 c print *,"Processor",myrank," computed Utord"
205 C 21/5/07 Calculate local sicdechain correlation energy
207 if (wsccor.gt.0.0d0) then
208 call eback_sc_corr(esccor)
212 c print *,"Processor",myrank," computed Usccorr"
214 C 12/1/95 Multi-body terms
218 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
219 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
220 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
221 c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
222 c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
229 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
230 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
237 c print *,"Processor",myrank," computed Ucorr"
239 C If performing constraint dynamics, call the constraint energy
240 C after the equilibration time
241 if(usampl.and.totT.gt.eq_time) then
244 call Econstr_back_qlike
252 c print *,"Processor",myrank," computed Uconstr"
258 energia(2)=evdw2-evdw2_14
275 energia(8)=eello_turn3
276 energia(9)=eello_turn4
283 energia(19)=edihcnstr
285 energia(20)=Uconst+Uconst_back
287 c print *," Processor",myrank," calls SUM_ENERGY"
288 call sum_energy(energia,.true.)
289 c print *," Processor",myrank," left SUM_ENERGY"
292 c-------------------------------------------------------------------------------
293 subroutine sum_energy(energia,reduce)
294 implicit real*8 (a-h,o-z)
299 cMS$ATTRIBUTES C :: proc_proc
305 include 'COMMON.SETUP'
306 include 'COMMON.IOUNITS'
307 double precision energia(0:n_ene),enebuff(0:n_ene+1)
308 include 'COMMON.FFIELD'
309 include 'COMMON.DERIV'
310 include 'COMMON.INTERACT'
311 include 'COMMON.SBRIDGE'
312 include 'COMMON.CHAIN'
314 include 'COMMON.CONTROL'
315 include 'COMMON.TIME1'
318 if (nfgtasks.gt.1 .and. reduce) then
320 write (iout,*) "energies before REDUCE"
321 call enerprint(energia)
325 enebuff(i)=energia(i)
328 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
329 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
331 write (iout,*) "energies after REDUCE"
332 call enerprint(energia)
335 time_Reduce=time_Reduce+MPI_Wtime()-time00
337 if (fg_rank.eq.0) then
341 evdw2=energia(2)+energia(18)
357 eello_turn3=energia(8)
358 eello_turn4=energia(9)
365 edihcnstr=energia(19)
370 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
371 & +wang*ebe+wtor*etors+wscloc*escloc
372 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
373 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
374 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
375 & +wbond*estr+Uconst+wsccor*esccor
377 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
378 & +wang*ebe+wtor*etors+wscloc*escloc
379 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
380 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
381 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
382 & +wbond*estr+Uconst+wsccor*esccor
388 if (isnan(etot).ne.0) energia(0)=1.0d+99
390 if (isnan(etot)) energia(0)=1.0d+99
395 idumm=proc_proc(etot,i)
397 call proc_proc(etot,i)
399 if(i.eq.1)energia(0)=1.0d+99
406 c-------------------------------------------------------------------------------
407 subroutine sum_gradient
408 implicit real*8 (a-h,o-z)
413 cMS$ATTRIBUTES C :: proc_proc
418 double precision gradbufc(3,maxres),gradbufx(3,maxres),
421 include 'COMMON.SETUP'
422 include 'COMMON.IOUNITS'
423 include 'COMMON.FFIELD'
424 include 'COMMON.DERIV'
425 include 'COMMON.INTERACT'
426 include 'COMMON.SBRIDGE'
427 include 'COMMON.CHAIN'
429 include 'COMMON.CONTROL'
430 include 'COMMON.TIME1'
431 include 'COMMON.MAXGRAD'
433 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
434 C in virtual-bond-vector coordinates
440 write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
442 write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
443 & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
445 write (iout,*) "gcorr4_turn, gel_loc_turn4"
447 write (iout,'(i5,3f10.5,2x,f10.5)')
448 & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
458 gvdwc(k,i)=gvdwc(k,i)+gvdwc(k,j)
459 gvdwc_scp(k,i)=gvdwc_scp(k,i)+gvdwc_scp(k,j)
465 gelc(k,i)=gelc(k,i)+0.5d0*gelc_long(k,i)
466 gvdwpp(k,i)=0.5d0*gvdwpp(k,i)
467 gvdwc_scp(k,i)=gvdwc_scp(k,i)+0.5d0*gvdwc_scpp(k,i)
471 gelc(k,i)=gelc(k,i)+gelc_long(k,j)
472 gvdwpp(k,i)=gvdwpp(k,i)+gvdwpp(k,j)
473 gvdwc_scp(k,i)=gvdwc_scp(k,i)+gvdwc_scpp(k,j)
479 gel_loc(k,i)=gel_loc(k,i)+0.5d0*gel_loc_long(k,i)
483 gel_loc(k,i)=gel_loc(k,i)+gel_loc_long(k,j)
488 gvdwc_scp(k,nres)=0.0d0
490 gel_loc(k,nres)=0.0d0
493 C Sum up the components of the Cartesian gradient.
498 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
499 & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
501 & wstrain*ghpbc(j,i)+
502 & wcorr*gradcorr(j,i)+
503 & wel_loc*gel_loc(j,i)+
504 & wturn3*gcorr3_turn(j,i)+
505 & wturn4*gcorr4_turn(j,i)+
506 & wcorr5*gradcorr5(j,i)+
507 & wcorr6*gradcorr6(j,i)+
508 & wturn6*gcorr6_turn(j,i)+
509 & wsccor*gsccorc(j,i)
510 & +wscloc*gscloc(j,i)
511 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
513 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
514 & wsccor*gsccorx(j,i)
515 & +wscloc*gsclocx(j,i)
521 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
522 & welec*gelc(j,i)+wstrain*ghpbc(j,i)+
524 & wcorr*gradcorr(j,i)+
525 & wel_loc*gel_loc(j,i)+
526 & wturn3*gcorr3_turn(j,i)+
527 & wturn4*gcorr4_turn(j,i)+
528 & wcorr5*gradcorr5(j,i)+
529 & wcorr6*gradcorr6(j,i)+
530 & wturn6*gcorr6_turn(j,i)+
531 & wsccor*gsccorc(j,i)
532 & +wscloc*gscloc(j,i)
533 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
535 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
536 & wsccor*gsccorx(j,i)
537 & +wscloc*gsclocx(j,i)
542 write (iout,*) "gloc before adding corr"
544 write (iout,*) i,gloc(i,icg)
548 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
549 & +wcorr5*g_corr5_loc(i)
550 & +wcorr6*g_corr6_loc(i)
551 & +wturn4*gel_loc_turn4(i)
552 & +wturn3*gel_loc_turn3(i)
553 & +wturn6*gel_loc_turn6(i)
554 & +wel_loc*gel_loc_loc(i)
555 & +wsccor*gsccor_loc(i)
558 write (iout,*) "gloc after adding corr"
560 write (iout,*) i,gloc(i,icg)
564 if (nfgtasks.gt.1) then
567 gradbufc(j,i)=gradc(j,i,icg)
568 gradbufx(j,i)=gradx(j,i,icg)
572 glocbuf(i)=gloc(i,icg)
574 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
575 if (fg_rank.eq.0) call MPI_Bcast(1,1,MPI_INTEGER,
576 & king,FG_COMM,IERROR)
578 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
579 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
580 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
581 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
582 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
583 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
584 time_reduce=time_reduce+MPI_Wtime()-time00
586 write (iout,*) "gloc after reduce"
588 write (iout,*) i,gloc(i,icg)
593 if (gnorm_check) then
595 c Compute the maximum elements of the gradient
605 gcorr3_turn_max=0.0d0
606 gcorr4_turn_max=0.0d0
609 gcorr6_turn_max=0.0d0
619 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
620 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
621 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
622 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
623 & gvdwc_scp_max=gvdwc_scp_norm
624 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
625 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
626 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
627 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
628 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
629 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
630 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
631 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
632 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
633 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
634 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
635 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
636 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
638 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
639 & gcorr3_turn_max=gcorr3_turn_norm
640 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
642 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
643 & gcorr4_turn_max=gcorr4_turn_norm
644 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
645 if (gradcorr5_norm.gt.gradcorr5_max)
646 & gradcorr5_max=gradcorr5_norm
647 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
648 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
649 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
651 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
652 & gcorr6_turn_max=gcorr6_turn_norm
653 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
654 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
655 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
656 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
657 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
658 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
659 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
660 if (gradx_scp_norm.gt.gradx_scp_max)
661 & gradx_scp_max=gradx_scp_norm
662 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
663 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
664 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
665 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
666 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
667 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
668 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
669 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
673 open(istat,file=statname,position="append")
675 open(istat,file=statname,access="append")
677 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
678 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
679 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
680 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
681 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
682 & gsccorx_max,gsclocx_max
684 if (gvdwc_max.gt.1.0d4) then
685 write (iout,*) "gvdwc gvdwx gradb gradbx"
687 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
688 & gradb(j,i),gradbx(j,i),j=1,3)
690 call pdbout(0.0d0,'cipiszcze',iout)
696 write (iout,*) "gradc gradx gloc"
698 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
699 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
703 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
707 c-------------------------------------------------------------------------------
708 subroutine rescale_weights(t_bath)
709 implicit real*8 (a-h,o-z)
711 include 'COMMON.IOUNITS'
712 include 'COMMON.FFIELD'
713 include 'COMMON.SBRIDGE'
714 double precision kfac /2.4d0/
715 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
717 c facT=2*temp0/(t_bath+temp0)
718 if (rescale_mode.eq.0) then
724 else if (rescale_mode.eq.1) then
725 facT=kfac/(kfac-1.0d0+t_bath/temp0)
726 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
727 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
728 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
729 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
730 else if (rescale_mode.eq.2) then
736 facT=licznik/dlog(dexp(x)+dexp(-x))
737 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
738 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
739 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
740 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
742 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
743 write (*,*) "Wrong RESCALE_MODE",rescale_mode
745 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
749 welec=weights(3)*fact
750 wcorr=weights(4)*fact3
751 wcorr5=weights(5)*fact4
752 wcorr6=weights(6)*fact5
753 wel_loc=weights(7)*fact2
754 wturn3=weights(8)*fact2
755 wturn4=weights(9)*fact3
756 wturn6=weights(10)*fact5
757 wtor=weights(13)*fact
758 wtor_d=weights(14)*fact2
759 wsccor=weights(21)*fact
763 C------------------------------------------------------------------------
764 subroutine enerprint(energia)
765 implicit real*8 (a-h,o-z)
767 include 'COMMON.IOUNITS'
768 include 'COMMON.FFIELD'
769 include 'COMMON.SBRIDGE'
771 double precision energia(0:n_ene)
776 evdw2=energia(2)+energia(18)
788 eello_turn3=energia(8)
789 eello_turn4=energia(9)
790 eello_turn6=energia(10)
796 edihcnstr=energia(19)
801 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
802 & estr,wbond,ebe,wang,
803 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
805 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
806 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
809 10 format (/'Virtual-chain energies:'//
810 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
811 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
812 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
813 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
814 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
815 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
816 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
817 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
818 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
819 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
820 & ' (SS bridges & dist. cnstr.)'/
821 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
822 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
823 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
824 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
825 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
826 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
827 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
828 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
829 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
830 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
831 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
832 & 'ETOT= ',1pE16.6,' (total)')
834 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
835 & estr,wbond,ebe,wang,
836 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
838 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
839 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
840 & ebr*nss,Uconst,etot
841 10 format (/'Virtual-chain energies:'//
842 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
843 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
844 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
845 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
846 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
847 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
848 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
849 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
850 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
851 & ' (SS bridges & dist. cnstr.)'/
852 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
853 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
854 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
855 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
856 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
857 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
858 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
859 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
860 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
861 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
862 & 'UCONST=',1pE16.6,' (Constraint energy)'/
863 & 'ETOT= ',1pE16.6,' (total)')
867 C-----------------------------------------------------------------------
870 C This subroutine calculates the interaction energy of nonbonded side chains
871 C assuming the LJ potential of interaction.
873 implicit real*8 (a-h,o-z)
875 parameter (accur=1.0d-10)
878 include 'COMMON.LOCAL'
879 include 'COMMON.CHAIN'
880 include 'COMMON.DERIV'
881 include 'COMMON.INTERACT'
882 include 'COMMON.TORSION'
883 include 'COMMON.SBRIDGE'
884 include 'COMMON.NAMES'
885 include 'COMMON.IOUNITS'
886 include 'COMMON.CONTACTS'
888 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
899 C Calculate SC interaction energy.
902 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
903 cd & 'iend=',iend(i,iint)
904 do j=istart(i,iint),iend(i,iint)
909 C Change 12/1/95 to calculate four-body interactions
910 rij=xj*xj+yj*yj+zj*zj
912 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
913 eps0ij=eps(itypi,itypj)
915 e1=fac*fac*aa(itypi,itypj)
916 e2=fac*bb(itypi,itypj)
918 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
919 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
920 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
921 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
922 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
923 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
926 C Calculate the components of the gradient in DC and X
928 fac=-rrij*(e1+evdwij)
933 gvdwx(k,i)=gvdwx(k,i)-gg(k)
934 gvdwx(k,j)=gvdwx(k,j)+gg(k)
935 gvdwc(k,i)=gvdwc(k,i)-gg(k)
936 gvdwc(k,j)=gvdwc(k,j)+gg(k)
940 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
944 C 12/1/95, revised on 5/20/97
946 C Calculate the contact function. The ith column of the array JCONT will
947 C contain the numbers of atoms that make contacts with the atom I (of numbers
948 C greater than I). The arrays FACONT and GACONT will contain the values of
949 C the contact function and its derivative.
951 C Uncomment next line, if the correlation interactions include EVDW explicitly.
952 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
953 C Uncomment next line, if the correlation interactions are contact function only
954 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
956 sigij=sigma(itypi,itypj)
957 r0ij=rs0(itypi,itypj)
959 C Check whether the SC's are not too far to make a contact.
962 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
963 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
965 if (fcont.gt.0.0D0) then
966 C If the SC-SC distance if close to sigma, apply spline.
967 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
968 cAdam & fcont1,fprimcont1)
969 cAdam fcont1=1.0d0-fcont1
970 cAdam if (fcont1.gt.0.0d0) then
971 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
972 cAdam fcont=fcont*fcont1
974 C Uncomment following 4 lines to have the geometric average of the epsilon0's
975 cga eps0ij=1.0d0/dsqrt(eps0ij)
977 cga gg(k)=gg(k)*eps0ij
979 cga eps0ij=-evdwij*eps0ij
980 C Uncomment for AL's type of SC correlation interactions.
982 num_conti=num_conti+1
984 facont(num_conti,i)=fcont*eps0ij
985 fprimcont=eps0ij*fprimcont/rij
987 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
988 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
989 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
990 C Uncomment following 3 lines for Skolnick's type of SC correlation.
991 gacont(1,num_conti,i)=-fprimcont*xj
992 gacont(2,num_conti,i)=-fprimcont*yj
993 gacont(3,num_conti,i)=-fprimcont*zj
994 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
995 cd write (iout,'(2i3,3f10.5)')
996 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1002 num_cont(i)=num_conti
1006 gvdwc(j,i)=expon*gvdwc(j,i)
1007 gvdwx(j,i)=expon*gvdwx(j,i)
1010 C******************************************************************************
1014 C To save time, the factor of EXPON has been extracted from ALL components
1015 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1018 C******************************************************************************
1021 C-----------------------------------------------------------------------------
1022 subroutine eljk(evdw)
1024 C This subroutine calculates the interaction energy of nonbonded side chains
1025 C assuming the LJK potential of interaction.
1027 implicit real*8 (a-h,o-z)
1028 include 'DIMENSIONS'
1029 include 'COMMON.GEO'
1030 include 'COMMON.VAR'
1031 include 'COMMON.LOCAL'
1032 include 'COMMON.CHAIN'
1033 include 'COMMON.DERIV'
1034 include 'COMMON.INTERACT'
1035 include 'COMMON.IOUNITS'
1036 include 'COMMON.NAMES'
1039 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1041 do i=iatsc_s,iatsc_e
1048 C Calculate SC interaction energy.
1050 do iint=1,nint_gr(i)
1051 do j=istart(i,iint),iend(i,iint)
1056 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1057 fac_augm=rrij**expon
1058 e_augm=augm(itypi,itypj)*fac_augm
1059 r_inv_ij=dsqrt(rrij)
1061 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1062 fac=r_shift_inv**expon
1063 e1=fac*fac*aa(itypi,itypj)
1064 e2=fac*bb(itypi,itypj)
1066 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1067 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1068 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1069 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1070 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1071 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1072 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1075 C Calculate the components of the gradient in DC and X
1077 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1082 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1083 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1084 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1085 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1089 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1097 gvdwc(j,i)=expon*gvdwc(j,i)
1098 gvdwx(j,i)=expon*gvdwx(j,i)
1103 C-----------------------------------------------------------------------------
1104 subroutine ebp(evdw)
1106 C This subroutine calculates the interaction energy of nonbonded side chains
1107 C assuming the Berne-Pechukas potential of interaction.
1109 implicit real*8 (a-h,o-z)
1110 include 'DIMENSIONS'
1111 include 'COMMON.GEO'
1112 include 'COMMON.VAR'
1113 include 'COMMON.LOCAL'
1114 include 'COMMON.CHAIN'
1115 include 'COMMON.DERIV'
1116 include 'COMMON.NAMES'
1117 include 'COMMON.INTERACT'
1118 include 'COMMON.IOUNITS'
1119 include 'COMMON.CALC'
1120 common /srutu/ icall
1121 c double precision rrsave(maxdim)
1124 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1126 c if (icall.eq.0) then
1132 do i=iatsc_s,iatsc_e
1138 dxi=dc_norm(1,nres+i)
1139 dyi=dc_norm(2,nres+i)
1140 dzi=dc_norm(3,nres+i)
1141 c dsci_inv=dsc_inv(itypi)
1142 dsci_inv=vbld_inv(i+nres)
1144 C Calculate SC interaction energy.
1146 do iint=1,nint_gr(i)
1147 do j=istart(i,iint),iend(i,iint)
1150 c dscj_inv=dsc_inv(itypj)
1151 dscj_inv=vbld_inv(j+nres)
1152 chi1=chi(itypi,itypj)
1153 chi2=chi(itypj,itypi)
1160 alf12=0.5D0*(alf1+alf2)
1161 C For diagnostics only!!!
1174 dxj=dc_norm(1,nres+j)
1175 dyj=dc_norm(2,nres+j)
1176 dzj=dc_norm(3,nres+j)
1177 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1178 cd if (icall.eq.0) then
1184 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1186 C Calculate whole angle-dependent part of epsilon and contributions
1187 C to its derivatives
1188 fac=(rrij*sigsq)**expon2
1189 e1=fac*fac*aa(itypi,itypj)
1190 e2=fac*bb(itypi,itypj)
1191 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1192 eps2der=evdwij*eps3rt
1193 eps3der=evdwij*eps2rt
1194 evdwij=evdwij*eps2rt*eps3rt
1197 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1198 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1199 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1200 cd & restyp(itypi),i,restyp(itypj),j,
1201 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1202 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1203 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1206 C Calculate gradient components.
1207 e1=e1*eps1*eps2rt**2*eps3rt**2
1208 fac=-expon*(e1+evdwij)
1211 C Calculate radial part of the gradient
1215 C Calculate the angular part of the gradient and sum add the contributions
1216 C to the appropriate components of the Cartesian gradient.
1224 C-----------------------------------------------------------------------------
1225 subroutine egb(evdw)
1227 C This subroutine calculates the interaction energy of nonbonded side chains
1228 C assuming the Gay-Berne potential of interaction.
1230 implicit real*8 (a-h,o-z)
1231 include 'DIMENSIONS'
1232 include 'COMMON.GEO'
1233 include 'COMMON.VAR'
1234 include 'COMMON.LOCAL'
1235 include 'COMMON.CHAIN'
1236 include 'COMMON.DERIV'
1237 include 'COMMON.NAMES'
1238 include 'COMMON.INTERACT'
1239 include 'COMMON.IOUNITS'
1240 include 'COMMON.CALC'
1241 include 'COMMON.CONTROL'
1244 ccccc energy_dec=.false.
1245 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1248 c if (icall.eq.0) lprn=.false.
1250 do i=iatsc_s,iatsc_e
1256 dxi=dc_norm(1,nres+i)
1257 dyi=dc_norm(2,nres+i)
1258 dzi=dc_norm(3,nres+i)
1259 c dsci_inv=dsc_inv(itypi)
1260 dsci_inv=vbld_inv(i+nres)
1261 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1262 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1264 C Calculate SC interaction energy.
1266 do iint=1,nint_gr(i)
1267 do j=istart(i,iint),iend(i,iint)
1270 c dscj_inv=dsc_inv(itypj)
1271 dscj_inv=vbld_inv(j+nres)
1272 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1273 c & 1.0d0/vbld(j+nres)
1274 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1275 sig0ij=sigma(itypi,itypj)
1276 chi1=chi(itypi,itypj)
1277 chi2=chi(itypj,itypi)
1284 alf12=0.5D0*(alf1+alf2)
1285 C For diagnostics only!!!
1298 dxj=dc_norm(1,nres+j)
1299 dyj=dc_norm(2,nres+j)
1300 dzj=dc_norm(3,nres+j)
1301 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1302 c write (iout,*) "j",j," dc_norm",
1303 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1304 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1306 C Calculate angle-dependent terms of energy and contributions to their
1310 sig=sig0ij*dsqrt(sigsq)
1311 rij_shift=1.0D0/rij-sig+sig0ij
1312 c for diagnostics; uncomment
1313 c rij_shift=1.2*sig0ij
1314 C I hate to put IF's in the loops, but here don't have another choice!!!!
1315 if (rij_shift.le.0.0D0) then
1317 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1318 cd & restyp(itypi),i,restyp(itypj),j,
1319 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1323 c---------------------------------------------------------------
1324 rij_shift=1.0D0/rij_shift
1325 fac=rij_shift**expon
1326 e1=fac*fac*aa(itypi,itypj)
1327 e2=fac*bb(itypi,itypj)
1328 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1329 eps2der=evdwij*eps3rt
1330 eps3der=evdwij*eps2rt
1331 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1332 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1333 evdwij=evdwij*eps2rt*eps3rt
1336 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1337 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1338 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1339 & restyp(itypi),i,restyp(itypj),j,
1340 & epsi,sigm,chi1,chi2,chip1,chip2,
1341 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1342 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1346 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1349 C Calculate gradient components.
1350 e1=e1*eps1*eps2rt**2*eps3rt**2
1351 fac=-expon*(e1+evdwij)*rij_shift
1355 C Calculate the radial part of the gradient
1359 C Calculate angular part of the gradient.
1364 c write (iout,*) "Number of loop steps in EGB:",ind
1365 cccc energy_dec=.false.
1368 C-----------------------------------------------------------------------------
1369 subroutine egbv(evdw)
1371 C This subroutine calculates the interaction energy of nonbonded side chains
1372 C assuming the Gay-Berne-Vorobjev potential of interaction.
1374 implicit real*8 (a-h,o-z)
1375 include 'DIMENSIONS'
1376 include 'COMMON.GEO'
1377 include 'COMMON.VAR'
1378 include 'COMMON.LOCAL'
1379 include 'COMMON.CHAIN'
1380 include 'COMMON.DERIV'
1381 include 'COMMON.NAMES'
1382 include 'COMMON.INTERACT'
1383 include 'COMMON.IOUNITS'
1384 include 'COMMON.CALC'
1385 common /srutu/ icall
1388 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1391 c if (icall.eq.0) lprn=.true.
1393 do i=iatsc_s,iatsc_e
1399 dxi=dc_norm(1,nres+i)
1400 dyi=dc_norm(2,nres+i)
1401 dzi=dc_norm(3,nres+i)
1402 c dsci_inv=dsc_inv(itypi)
1403 dsci_inv=vbld_inv(i+nres)
1405 C Calculate SC interaction energy.
1407 do iint=1,nint_gr(i)
1408 do j=istart(i,iint),iend(i,iint)
1411 c dscj_inv=dsc_inv(itypj)
1412 dscj_inv=vbld_inv(j+nres)
1413 sig0ij=sigma(itypi,itypj)
1414 r0ij=r0(itypi,itypj)
1415 chi1=chi(itypi,itypj)
1416 chi2=chi(itypj,itypi)
1423 alf12=0.5D0*(alf1+alf2)
1424 C For diagnostics only!!!
1437 dxj=dc_norm(1,nres+j)
1438 dyj=dc_norm(2,nres+j)
1439 dzj=dc_norm(3,nres+j)
1440 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1442 C Calculate angle-dependent terms of energy and contributions to their
1446 sig=sig0ij*dsqrt(sigsq)
1447 rij_shift=1.0D0/rij-sig+r0ij
1448 C I hate to put IF's in the loops, but here don't have another choice!!!!
1449 if (rij_shift.le.0.0D0) then
1454 c---------------------------------------------------------------
1455 rij_shift=1.0D0/rij_shift
1456 fac=rij_shift**expon
1457 e1=fac*fac*aa(itypi,itypj)
1458 e2=fac*bb(itypi,itypj)
1459 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1460 eps2der=evdwij*eps3rt
1461 eps3der=evdwij*eps2rt
1462 fac_augm=rrij**expon
1463 e_augm=augm(itypi,itypj)*fac_augm
1464 evdwij=evdwij*eps2rt*eps3rt
1465 evdw=evdw+evdwij+e_augm
1467 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1468 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1469 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1470 & restyp(itypi),i,restyp(itypj),j,
1471 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1472 & chi1,chi2,chip1,chip2,
1473 & eps1,eps2rt**2,eps3rt**2,
1474 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1477 C Calculate gradient components.
1478 e1=e1*eps1*eps2rt**2*eps3rt**2
1479 fac=-expon*(e1+evdwij)*rij_shift
1481 fac=rij*fac-2*expon*rrij*e_augm
1482 C Calculate the radial part of the gradient
1486 C Calculate angular part of the gradient.
1492 C-----------------------------------------------------------------------------
1493 subroutine sc_angular
1494 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1495 C om12. Called by ebp, egb, and egbv.
1497 include 'COMMON.CALC'
1498 include 'COMMON.IOUNITS'
1502 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1503 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1504 om12=dxi*dxj+dyi*dyj+dzi*dzj
1506 C Calculate eps1(om12) and its derivative in om12
1507 faceps1=1.0D0-om12*chiom12
1508 faceps1_inv=1.0D0/faceps1
1509 eps1=dsqrt(faceps1_inv)
1510 C Following variable is eps1*deps1/dom12
1511 eps1_om12=faceps1_inv*chiom12
1516 c write (iout,*) "om12",om12," eps1",eps1
1517 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1522 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1523 sigsq=1.0D0-facsig*faceps1_inv
1524 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1525 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1526 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1532 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1533 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1535 C Calculate eps2 and its derivatives in om1, om2, and om12.
1538 chipom12=chip12*om12
1539 facp=1.0D0-om12*chipom12
1541 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1542 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1543 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1544 C Following variable is the square root of eps2
1545 eps2rt=1.0D0-facp1*facp_inv
1546 C Following three variables are the derivatives of the square root of eps
1547 C in om1, om2, and om12.
1548 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1549 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1550 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1551 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1552 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1553 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1554 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1555 c & " eps2rt_om12",eps2rt_om12
1556 C Calculate whole angle-dependent part of epsilon and contributions
1557 C to its derivatives
1560 C----------------------------------------------------------------------------
1562 implicit real*8 (a-h,o-z)
1563 include 'DIMENSIONS'
1564 include 'COMMON.CHAIN'
1565 include 'COMMON.DERIV'
1566 include 'COMMON.CALC'
1567 include 'COMMON.IOUNITS'
1568 double precision dcosom1(3),dcosom2(3)
1569 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1570 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1571 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1572 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1576 c eom12=evdwij*eps1_om12
1578 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1579 c & " sigder",sigder
1580 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1581 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1583 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1584 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1587 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1589 c write (iout,*) "gg",(gg(k),k=1,3)
1591 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1592 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1593 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1594 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1595 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1596 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1597 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1598 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1599 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1600 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1603 C Calculate the components of the gradient in DC and X
1607 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1611 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1612 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1616 C-----------------------------------------------------------------------
1617 subroutine e_softsphere(evdw)
1619 C This subroutine calculates the interaction energy of nonbonded side chains
1620 C assuming the LJ potential of interaction.
1622 implicit real*8 (a-h,o-z)
1623 include 'DIMENSIONS'
1624 parameter (accur=1.0d-10)
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.TORSION'
1632 include 'COMMON.SBRIDGE'
1633 include 'COMMON.NAMES'
1634 include 'COMMON.IOUNITS'
1635 include 'COMMON.CONTACTS'
1637 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1639 do i=iatsc_s,iatsc_e
1646 C Calculate SC interaction energy.
1648 do iint=1,nint_gr(i)
1649 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1650 cd & 'iend=',iend(i,iint)
1651 do j=istart(i,iint),iend(i,iint)
1656 rij=xj*xj+yj*yj+zj*zj
1657 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1658 r0ij=r0(itypi,itypj)
1660 c print *,i,j,r0ij,dsqrt(rij)
1661 if (rij.lt.r0ijsq) then
1662 evdwij=0.25d0*(rij-r0ijsq)**2
1670 C Calculate the components of the gradient in DC and X
1676 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1677 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1678 gvdwc(k,i)=gvdwc(l,k)-gg(k)
1679 gvdwc(k,j)=gvdwc(l,k)+gg(k)
1683 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1691 C--------------------------------------------------------------------------
1692 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1695 C Soft-sphere potential of p-p interaction
1697 implicit real*8 (a-h,o-z)
1698 include 'DIMENSIONS'
1699 include 'COMMON.CONTROL'
1700 include 'COMMON.IOUNITS'
1701 include 'COMMON.GEO'
1702 include 'COMMON.VAR'
1703 include 'COMMON.LOCAL'
1704 include 'COMMON.CHAIN'
1705 include 'COMMON.DERIV'
1706 include 'COMMON.INTERACT'
1707 include 'COMMON.CONTACTS'
1708 include 'COMMON.TORSION'
1709 include 'COMMON.VECTORS'
1710 include 'COMMON.FFIELD'
1712 cd write(iout,*) 'In EELEC_soft_sphere'
1719 do i=iatel_s,iatel_e
1723 xmedi=c(1,i)+0.5d0*dxi
1724 ymedi=c(2,i)+0.5d0*dyi
1725 zmedi=c(3,i)+0.5d0*dzi
1727 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1728 do j=ielstart(i),ielend(i)
1732 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1733 r0ij=rpp(iteli,itelj)
1738 xj=c(1,j)+0.5D0*dxj-xmedi
1739 yj=c(2,j)+0.5D0*dyj-ymedi
1740 zj=c(3,j)+0.5D0*dzj-zmedi
1741 rij=xj*xj+yj*yj+zj*zj
1742 if (rij.lt.r0ijsq) then
1743 evdw1ij=0.25d0*(rij-r0ijsq)**2
1751 C Calculate contributions to the Cartesian gradient.
1757 gelc(k,i)=gelc(k,i)-ggg(k)
1758 gelc(k,j)=gelc(k,j)+ggg(k)
1761 * Loop over residues i+1 thru j-1.
1765 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1772 gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1776 gelc(k,i)=gelc(k,i)+gelc(k,j)
1782 c------------------------------------------------------------------------------
1783 subroutine vec_and_deriv
1784 implicit real*8 (a-h,o-z)
1785 include 'DIMENSIONS'
1789 include 'COMMON.IOUNITS'
1790 include 'COMMON.GEO'
1791 include 'COMMON.VAR'
1792 include 'COMMON.LOCAL'
1793 include 'COMMON.CHAIN'
1794 include 'COMMON.VECTORS'
1795 include 'COMMON.SETUP'
1796 include 'COMMON.TIME1'
1797 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1798 C Compute the local reference systems. For reference system (i), the
1799 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1800 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1802 do i=ivec_start,ivec_end
1806 if (i.eq.nres-1) then
1807 C Case of the last full residue
1808 C Compute the Z-axis
1809 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1810 costh=dcos(pi-theta(nres))
1811 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1815 C Compute the derivatives of uz
1817 uzder(2,1,1)=-dc_norm(3,i-1)
1818 uzder(3,1,1)= dc_norm(2,i-1)
1819 uzder(1,2,1)= dc_norm(3,i-1)
1821 uzder(3,2,1)=-dc_norm(1,i-1)
1822 uzder(1,3,1)=-dc_norm(2,i-1)
1823 uzder(2,3,1)= dc_norm(1,i-1)
1826 uzder(2,1,2)= dc_norm(3,i)
1827 uzder(3,1,2)=-dc_norm(2,i)
1828 uzder(1,2,2)=-dc_norm(3,i)
1830 uzder(3,2,2)= dc_norm(1,i)
1831 uzder(1,3,2)= dc_norm(2,i)
1832 uzder(2,3,2)=-dc_norm(1,i)
1834 C Compute the Y-axis
1837 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1839 C Compute the derivatives of uy
1842 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1843 & -dc_norm(k,i)*dc_norm(j,i-1)
1844 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1846 uyder(j,j,1)=uyder(j,j,1)-costh
1847 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1852 uygrad(l,k,j,i)=uyder(l,k,j)
1853 uzgrad(l,k,j,i)=uzder(l,k,j)
1857 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1858 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1859 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1860 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1863 C Compute the Z-axis
1864 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1865 costh=dcos(pi-theta(i+2))
1866 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1870 C Compute the derivatives of uz
1872 uzder(2,1,1)=-dc_norm(3,i+1)
1873 uzder(3,1,1)= dc_norm(2,i+1)
1874 uzder(1,2,1)= dc_norm(3,i+1)
1876 uzder(3,2,1)=-dc_norm(1,i+1)
1877 uzder(1,3,1)=-dc_norm(2,i+1)
1878 uzder(2,3,1)= dc_norm(1,i+1)
1881 uzder(2,1,2)= dc_norm(3,i)
1882 uzder(3,1,2)=-dc_norm(2,i)
1883 uzder(1,2,2)=-dc_norm(3,i)
1885 uzder(3,2,2)= dc_norm(1,i)
1886 uzder(1,3,2)= dc_norm(2,i)
1887 uzder(2,3,2)=-dc_norm(1,i)
1889 C Compute the Y-axis
1892 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1894 C Compute the derivatives of uy
1897 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1898 & -dc_norm(k,i)*dc_norm(j,i+1)
1899 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1901 uyder(j,j,1)=uyder(j,j,1)-costh
1902 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1907 uygrad(l,k,j,i)=uyder(l,k,j)
1908 uzgrad(l,k,j,i)=uzder(l,k,j)
1912 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1913 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1914 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1915 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1919 vbld_inv_temp(1)=vbld_inv(i+1)
1920 if (i.lt.nres-1) then
1921 vbld_inv_temp(2)=vbld_inv(i+2)
1923 vbld_inv_temp(2)=vbld_inv(i)
1928 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1929 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1934 #if defined(PARVEC) && defined(MPI)
1935 if (nfgtasks.gt.1) then
1937 c print *,"Processor",fg_rank,kolor," ivec_start",ivec_start,
1938 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
1939 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
1940 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank),
1941 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
1943 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank),
1944 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
1946 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
1947 & ivec_count(fg_rank),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
1948 & ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR)
1949 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
1950 & ivec_count(fg_rank),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
1951 & ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR)
1952 time_gather=time_gather+MPI_Wtime()-time00
1954 c if (fg_rank.eq.0) then
1955 c write (iout,*) "Arrays UY and UZ"
1957 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
1964 C-----------------------------------------------------------------------------
1965 subroutine check_vecgrad
1966 implicit real*8 (a-h,o-z)
1967 include 'DIMENSIONS'
1968 include 'COMMON.IOUNITS'
1969 include 'COMMON.GEO'
1970 include 'COMMON.VAR'
1971 include 'COMMON.LOCAL'
1972 include 'COMMON.CHAIN'
1973 include 'COMMON.VECTORS'
1974 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1975 dimension uyt(3,maxres),uzt(3,maxres)
1976 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1977 double precision delta /1.0d-7/
1980 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1981 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1982 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1983 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1984 cd & (dc_norm(if90,i),if90=1,3)
1985 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1986 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1987 cd write(iout,'(a)')
1993 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1994 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2007 cd write (iout,*) 'i=',i
2009 erij(k)=dc_norm(k,i)
2013 dc_norm(k,i)=erij(k)
2015 dc_norm(j,i)=dc_norm(j,i)+delta
2016 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2018 c dc_norm(k,i)=dc_norm(k,i)/fac
2020 c write (iout,*) (dc_norm(k,i),k=1,3)
2021 c write (iout,*) (erij(k),k=1,3)
2024 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2025 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2026 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2027 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2029 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2030 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2031 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2034 dc_norm(k,i)=erij(k)
2037 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2038 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2039 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2040 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2041 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2042 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2043 cd write (iout,'(a)')
2048 C--------------------------------------------------------------------------
2049 subroutine set_matrices
2050 implicit real*8 (a-h,o-z)
2051 include 'DIMENSIONS'
2054 include "COMMON.SETUP"
2056 integer status(MPI_STATUS_SIZE)
2058 include 'COMMON.IOUNITS'
2059 include 'COMMON.GEO'
2060 include 'COMMON.VAR'
2061 include 'COMMON.LOCAL'
2062 include 'COMMON.CHAIN'
2063 include 'COMMON.DERIV'
2064 include 'COMMON.INTERACT'
2065 include 'COMMON.CONTACTS'
2066 include 'COMMON.TORSION'
2067 include 'COMMON.VECTORS'
2068 include 'COMMON.FFIELD'
2069 double precision auxvec(2),auxmat(2,2)
2071 C Compute the virtual-bond-torsional-angle dependent quantities needed
2072 C to calculate the el-loc multibody terms of various order.
2075 do i=ivec_start+2,ivec_end+2
2079 if (i .lt. nres+1) then
2116 if (i .gt. 3 .and. i .lt. nres+1) then
2117 obrot_der(1,i-2)=-sin1
2118 obrot_der(2,i-2)= cos1
2119 Ugder(1,1,i-2)= sin1
2120 Ugder(1,2,i-2)=-cos1
2121 Ugder(2,1,i-2)=-cos1
2122 Ugder(2,2,i-2)=-sin1
2125 obrot2_der(1,i-2)=-dwasin2
2126 obrot2_der(2,i-2)= dwacos2
2127 Ug2der(1,1,i-2)= dwasin2
2128 Ug2der(1,2,i-2)=-dwacos2
2129 Ug2der(2,1,i-2)=-dwacos2
2130 Ug2der(2,2,i-2)=-dwasin2
2132 obrot_der(1,i-2)=0.0d0
2133 obrot_der(2,i-2)=0.0d0
2134 Ugder(1,1,i-2)=0.0d0
2135 Ugder(1,2,i-2)=0.0d0
2136 Ugder(2,1,i-2)=0.0d0
2137 Ugder(2,2,i-2)=0.0d0
2138 obrot2_der(1,i-2)=0.0d0
2139 obrot2_der(2,i-2)=0.0d0
2140 Ug2der(1,1,i-2)=0.0d0
2141 Ug2der(1,2,i-2)=0.0d0
2142 Ug2der(2,1,i-2)=0.0d0
2143 Ug2der(2,2,i-2)=0.0d0
2145 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2146 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2147 iti = itortyp(itype(i-2))
2151 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2152 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2153 iti1 = itortyp(itype(i-1))
2157 cd write (iout,*) '*******i',i,' iti1',iti
2158 cd write (iout,*) 'b1',b1(:,iti)
2159 cd write (iout,*) 'b2',b2(:,iti)
2160 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2161 c if (i .gt. iatel_s+2) then
2162 if (i .gt. nnt+2) then
2163 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2164 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2165 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2167 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2168 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2169 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2170 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2171 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2182 DtUg2(l,k,i-2)=0.0d0
2186 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2187 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2189 muder(k,i-2)=Ub2der(k,i-2)
2191 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2192 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2193 iti1 = itortyp(itype(i-1))
2198 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2200 cd write (iout,*) 'mu ',mu(:,i-2)
2201 cd write (iout,*) 'mu1',mu1(:,i-2)
2202 cd write (iout,*) 'mu2',mu2(:,i-2)
2203 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2205 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2206 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2207 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2208 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2209 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2210 C Vectors and matrices dependent on a single virtual-bond dihedral.
2211 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2212 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2213 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2214 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2215 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2216 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2217 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2218 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2219 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2222 C Matrices dependent on two consecutive virtual-bond dihedrals.
2223 C The order of matrices is from left to right.
2224 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2226 do i=ivec_start,ivec_end
2228 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2229 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2230 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2231 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2232 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2233 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2234 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2235 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2238 #if defined(MPI) && defined(PARMAT)
2240 c if (fg_rank.eq.0) then
2241 write (iout,*) "Arrays UG and UGDER before GATHER"
2243 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2244 & ((ug(l,k,i),l=1,2),k=1,2),
2245 & ((ugder(l,k,i),l=1,2),k=1,2)
2247 write (iout,*) "Arrays UG2 and UG2DER"
2249 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2250 & ((ug2(l,k,i),l=1,2),k=1,2),
2251 & ((ug2der(l,k,i),l=1,2),k=1,2)
2253 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2255 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2256 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2257 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2259 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2261 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2262 & costab(i),sintab(i),costab2(i),sintab2(i)
2264 write (iout,*) "Array MUDER"
2266 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2270 if (nfgtasks.gt.1) then
2272 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2273 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2274 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2276 c write (iout,*) "MPI_ROTAT",MPI_ROTAT
2277 c call MPI_Allgatherv(ug(1,1,ivec_start),ivec_count(fg_rank),
2278 c & MPI_MAT1,ug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2280 c call MPI_Allgatherv(ugder(1,1,ivec_start),ivec_count(fg_rank),
2281 c & MPI_MAT1,ugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2283 c call MPI_Allgatherv(ug2(1,1,ivec_start),ivec_count(fg_rank),
2284 c & MPI_MAT1,ug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2286 c call MPI_Allgatherv(ug2der(1,1,ivec_start),ivec_count(fg_rank),
2287 c & MPI_MAT1,ug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2289 c call MPI_Allgatherv(obrot(1,ivec_start),ivec_count(fg_rank),
2290 c & MPI_MU,obrot(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2292 c call MPI_Allgatherv(obrot2(1,ivec_start),ivec_count(fg_rank),
2293 c & MPI_MU,obrot2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2295 c call MPI_Allgatherv(obrot_der(1,ivec_start),ivec_count(fg_rank),
2296 c & MPI_MU,obrot_der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2298 c call MPI_Allgatherv(obrot2_der(1,ivec_start),
2299 c & ivec_count(fg_rank),
2300 c & MPI_MU,obrot2_der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2302 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank),
2303 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2305 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank),
2306 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2308 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank),
2309 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2311 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank),
2312 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2314 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank),
2315 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2317 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank),
2318 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2320 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank),
2321 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2322 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2323 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank),
2324 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2325 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2326 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank),
2327 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2328 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2329 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank),
2330 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2331 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2332 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2334 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank),
2335 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2337 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank),
2338 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2340 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank),
2341 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2343 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank),
2344 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2346 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank),
2347 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2349 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2350 & ivec_count(fg_rank),
2351 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2353 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank),
2354 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2356 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank),
2357 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2359 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank),
2360 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2362 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank),
2363 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2365 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank),
2366 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2368 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank),
2369 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2371 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank),
2372 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2374 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2375 & ivec_count(fg_rank),
2376 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2378 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank),
2379 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2381 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank),
2382 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2384 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank),
2385 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2387 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank),
2388 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2390 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2391 & ivec_count(fg_rank),
2392 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2394 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2395 & ivec_count(fg_rank),
2396 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2398 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2399 & ivec_count(fg_rank),
2400 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2401 & MPI_MAT2,FG_COMM,IERR)
2402 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2403 & ivec_count(fg_rank),
2404 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2405 & MPI_MAT2,FG_COMM,IERR)
2408 c Passes matrix info through the ring
2411 if (irecv.lt.0) irecv=nfgtasks-1
2414 if (inext.ge.nfgtasks) inext=0
2416 c write (iout,*) "isend",isend," irecv",irecv
2418 lensend=lentyp(isend)
2419 lenrecv=lentyp(irecv)
2420 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2421 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2422 c & MPI_ROTAT1(lensend),inext,2200+isend,
2423 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2424 c & iprev,2200+irecv,FG_COMM,status,IERR)
2425 c write (iout,*) "Gather ROTAT1"
2427 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2428 c & MPI_ROTAT2(lensend),inext,3300+isend,
2429 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2430 c & iprev,3300+irecv,FG_COMM,status,IERR)
2431 c write (iout,*) "Gather ROTAT2"
2433 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2434 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2435 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2436 & iprev,4400+irecv,FG_COMM,status,IERR)
2437 c write (iout,*) "Gather ROTAT_OLD"
2439 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2440 & MPI_PRECOMP11(lensend),inext,5500+isend,
2441 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2442 & iprev,5500+irecv,FG_COMM,status,IERR)
2443 c write (iout,*) "Gather PRECOMP11"
2445 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2446 & MPI_PRECOMP12(lensend),inext,6600+isend,
2447 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2448 & iprev,6600+irecv,FG_COMM,status,IERR)
2449 c write (iout,*) "Gather PRECOMP12"
2451 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2453 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2454 & MPI_ROTAT2(lensend),inext,7700+isend,
2455 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2456 & iprev,7700+irecv,FG_COMM,status,IERR)
2457 c write (iout,*) "Gather PRECOMP21"
2459 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2460 & MPI_PRECOMP22(lensend),inext,8800+isend,
2461 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2462 & iprev,8800+irecv,FG_COMM,status,IERR)
2463 c write (iout,*) "Gather PRECOMP22"
2465 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2466 & MPI_PRECOMP23(lensend),inext,9900+isend,
2467 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2468 & MPI_PRECOMP23(lenrecv),
2469 & iprev,9900+irecv,FG_COMM,status,IERR)
2470 c write (iout,*) "Gather PRECOMP23"
2475 if (irecv.lt.0) irecv=nfgtasks-1
2478 time_gather=time_gather+MPI_Wtime()-time00
2481 c if (fg_rank.eq.0) then
2482 write (iout,*) "Arrays UG and UGDER"
2484 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2485 & ((ug(l,k,i),l=1,2),k=1,2),
2486 & ((ugder(l,k,i),l=1,2),k=1,2)
2488 write (iout,*) "Arrays UG2 and UG2DER"
2490 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2491 & ((ug2(l,k,i),l=1,2),k=1,2),
2492 & ((ug2der(l,k,i),l=1,2),k=1,2)
2494 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2496 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2497 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2498 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2500 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2502 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2503 & costab(i),sintab(i),costab2(i),sintab2(i)
2505 write (iout,*) "Array MUDER"
2507 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2513 cd iti = itortyp(itype(i))
2516 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2517 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2522 C--------------------------------------------------------------------------
2523 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2525 C This subroutine calculates the average interaction energy and its gradient
2526 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2527 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2528 C The potential depends both on the distance of peptide-group centers and on
2529 C the orientation of the CA-CA virtual bonds.
2531 implicit real*8 (a-h,o-z)
2532 include 'DIMENSIONS'
2533 include 'COMMON.CONTROL'
2534 include 'COMMON.SETUP'
2535 include 'COMMON.IOUNITS'
2536 include 'COMMON.GEO'
2537 include 'COMMON.VAR'
2538 include 'COMMON.LOCAL'
2539 include 'COMMON.CHAIN'
2540 include 'COMMON.DERIV'
2541 include 'COMMON.INTERACT'
2542 include 'COMMON.CONTACTS'
2543 include 'COMMON.TORSION'
2544 include 'COMMON.VECTORS'
2545 include 'COMMON.FFIELD'
2546 include 'COMMON.TIME1'
2547 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2548 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2549 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2550 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2551 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2552 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2554 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2556 double precision scal_el /1.0d0/
2558 double precision scal_el /0.5d0/
2561 C 13-go grudnia roku pamietnego...
2562 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2563 & 0.0d0,1.0d0,0.0d0,
2564 & 0.0d0,0.0d0,1.0d0/
2565 cd write(iout,*) 'In EELEC'
2567 cd write(iout,*) 'Type',i
2568 cd write(iout,*) 'B1',B1(:,i)
2569 cd write(iout,*) 'B2',B2(:,i)
2570 cd write(iout,*) 'CC',CC(:,:,i)
2571 cd write(iout,*) 'DD',DD(:,:,i)
2572 cd write(iout,*) 'EE',EE(:,:,i)
2574 cd call check_vecgrad
2576 if (icheckgrad.eq.1) then
2578 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2580 dc_norm(k,i)=dc(k,i)*fac
2582 c write (iout,*) 'i',i,' fac',fac
2585 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2586 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2587 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2588 c call vec_and_deriv
2592 cd write (iout,*) 'i=',i
2594 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2597 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2598 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2611 cd print '(a)','Enter EELEC'
2612 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2614 gel_loc_loc(i)=0.0d0
2619 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2621 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2623 do i=iturn3_start,iturn3_end
2627 dx_normi=dc_norm(1,i)
2628 dy_normi=dc_norm(2,i)
2629 dz_normi=dc_norm(3,i)
2630 xmedi=c(1,i)+0.5d0*dxi
2631 ymedi=c(2,i)+0.5d0*dyi
2632 zmedi=c(3,i)+0.5d0*dzi
2634 call eelecij(i,i+2,ees,evdw1,eel_loc)
2635 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2636 num_cont_hb(i)=num_conti
2638 do i=iturn4_start,iturn4_end
2642 dx_normi=dc_norm(1,i)
2643 dy_normi=dc_norm(2,i)
2644 dz_normi=dc_norm(3,i)
2645 xmedi=c(1,i)+0.5d0*dxi
2646 ymedi=c(2,i)+0.5d0*dyi
2647 zmedi=c(3,i)+0.5d0*dzi
2649 call eelecij(i,i+3,ees,evdw1,eel_loc)
2650 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
2651 num_cont_hb(i)=num_cont_hb(i)+num_conti
2654 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2656 do i=iatel_s,iatel_e
2660 dx_normi=dc_norm(1,i)
2661 dy_normi=dc_norm(2,i)
2662 dz_normi=dc_norm(3,i)
2663 xmedi=c(1,i)+0.5d0*dxi
2664 ymedi=c(2,i)+0.5d0*dyi
2665 zmedi=c(3,i)+0.5d0*dzi
2667 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2668 do j=ielstart(i),ielend(i)
2669 call eelecij(i,j,ees,evdw1,eel_loc)
2671 num_cont_hb(i)=num_cont_hb(i)+num_conti
2673 c write (iout,*) "Number of loop steps in EELEC:",ind
2675 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2676 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2678 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2679 ccc eel_loc=eel_loc+eello_turn3
2680 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2683 C-------------------------------------------------------------------------------
2684 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2685 implicit real*8 (a-h,o-z)
2686 include 'DIMENSIONS'
2690 include 'COMMON.CONTROL'
2691 include 'COMMON.IOUNITS'
2692 include 'COMMON.GEO'
2693 include 'COMMON.VAR'
2694 include 'COMMON.LOCAL'
2695 include 'COMMON.CHAIN'
2696 include 'COMMON.DERIV'
2697 include 'COMMON.INTERACT'
2698 include 'COMMON.CONTACTS'
2699 include 'COMMON.TORSION'
2700 include 'COMMON.VECTORS'
2701 include 'COMMON.FFIELD'
2702 include 'COMMON.TIME1'
2703 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2704 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2705 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2706 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2707 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2708 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2710 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2712 double precision scal_el /1.0d0/
2714 double precision scal_el /0.5d0/
2717 C 13-go grudnia roku pamietnego...
2718 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2719 & 0.0d0,1.0d0,0.0d0,
2720 & 0.0d0,0.0d0,1.0d0/
2721 c time00=MPI_Wtime()
2722 cd write (iout,*) "eelecij",i,j
2726 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2727 aaa=app(iteli,itelj)
2728 bbb=bpp(iteli,itelj)
2729 ael6i=ael6(iteli,itelj)
2730 ael3i=ael3(iteli,itelj)
2734 dx_normj=dc_norm(1,j)
2735 dy_normj=dc_norm(2,j)
2736 dz_normj=dc_norm(3,j)
2737 xj=c(1,j)+0.5D0*dxj-xmedi
2738 yj=c(2,j)+0.5D0*dyj-ymedi
2739 zj=c(3,j)+0.5D0*dzj-zmedi
2740 rij=xj*xj+yj*yj+zj*zj
2746 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2747 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2748 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2749 fac=cosa-3.0D0*cosb*cosg
2751 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2752 if (j.eq.i+2) ev1=scal_el*ev1
2757 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2760 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2761 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2764 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2765 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2766 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2767 cd & xmedi,ymedi,zmedi,xj,yj,zj
2769 if (energy_dec) then
2770 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2771 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2775 C Calculate contributions to the Cartesian gradient.
2778 facvdw=-6*rrmij*(ev1+evdwij)
2779 facel=-3*rrmij*(el1+eesij)
2785 * Radial derivatives. First process both termini of the fragment (i,j)
2791 c ghalf=0.5D0*ggg(k)
2792 c gelc(k,i)=gelc(k,i)+ghalf
2793 c gelc(k,j)=gelc(k,j)+ghalf
2795 c 9/28/08 AL Gradient compotents will be summed only at the end
2797 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2798 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2801 * Loop over residues i+1 thru j-1.
2805 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2812 c ghalf=0.5D0*ggg(k)
2813 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2814 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2816 c 9/28/08 AL Gradient compotents will be summed only at the end
2818 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2819 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2822 * Loop over residues i+1 thru j-1.
2826 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2833 fac=-3*rrmij*(facvdw+facvdw+facel)
2838 * Radial derivatives. First process both termini of the fragment (i,j)
2844 c ghalf=0.5D0*ggg(k)
2845 c gelc(k,i)=gelc(k,i)+ghalf
2846 c gelc(k,j)=gelc(k,j)+ghalf
2848 c 9/28/08 AL Gradient compotents will be summed only at the end
2850 gelc_long(k,j)=gelc(k,j)+ggg(k)
2851 gelc_long(k,i)=gelc(k,i)-ggg(k)
2854 * Loop over residues i+1 thru j-1.
2858 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2861 c 9/28/08 AL Gradient compotents will be summed only at the end
2866 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2867 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2873 ecosa=2.0D0*fac3*fac1+fac4
2876 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2877 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2879 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2880 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2882 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2883 cd & (dcosg(k),k=1,3)
2885 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2888 c ghalf=0.5D0*ggg(k)
2889 c gelc(k,i)=gelc(k,i)+ghalf
2890 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2891 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2892 c gelc(k,j)=gelc(k,j)+ghalf
2893 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2894 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2898 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2903 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2904 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2906 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2907 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2908 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2909 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2911 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2912 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2913 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2915 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2916 C energy of a peptide unit is assumed in the form of a second-order
2917 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2918 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2919 C are computed for EVERY pair of non-contiguous peptide groups.
2921 if (j.lt.nres-1) then
2932 muij(kkk)=mu(k,i)*mu(l,j)
2935 cd write (iout,*) 'EELEC: i',i,' j',j
2936 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2937 cd write(iout,*) 'muij',muij
2938 ury=scalar(uy(1,i),erij)
2939 urz=scalar(uz(1,i),erij)
2940 vry=scalar(uy(1,j),erij)
2941 vrz=scalar(uz(1,j),erij)
2942 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2943 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2944 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2945 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2946 fac=dsqrt(-ael6i)*r3ij
2951 cd write (iout,'(4i5,4f10.5)')
2952 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2953 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2954 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2955 cd & uy(:,j),uz(:,j)
2956 cd write (iout,'(4f10.5)')
2957 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2958 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2959 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2960 cd write (iout,'(9f10.5/)')
2961 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2962 C Derivatives of the elements of A in virtual-bond vectors
2963 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2965 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2966 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2967 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2968 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2969 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2970 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2971 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2972 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2973 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2974 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2975 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2976 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2978 C Compute radial contributions to the gradient
2996 C Add the contributions coming from er
2999 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3000 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3001 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3002 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3005 C Derivatives in DC(i)
3006 ghalf1=0.5d0*agg(k,1)
3007 ghalf2=0.5d0*agg(k,2)
3008 ghalf3=0.5d0*agg(k,3)
3009 ghalf4=0.5d0*agg(k,4)
3010 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3011 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3012 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3013 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3014 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3015 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3016 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3017 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3018 C Derivatives in DC(i+1)
3019 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3020 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3021 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3022 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3023 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3024 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3025 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3026 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3027 C Derivatives in DC(j)
3028 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3029 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3030 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3031 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3032 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3033 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3034 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3035 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3036 C Derivatives in DC(j+1) or DC(nres-1)
3037 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3038 & -3.0d0*vryg(k,3)*ury)
3039 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3040 & -3.0d0*vrzg(k,3)*ury)
3041 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3042 & -3.0d0*vryg(k,3)*urz)
3043 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3044 & -3.0d0*vrzg(k,3)*urz)
3045 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3047 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3060 aggi(k,l)=-aggi(k,l)
3061 aggi1(k,l)=-aggi1(k,l)
3062 aggj(k,l)=-aggj(k,l)
3063 aggj1(k,l)=-aggj1(k,l)
3066 if (j.lt.nres-1) then
3072 aggi(k,l)=-aggi(k,l)
3073 aggi1(k,l)=-aggi1(k,l)
3074 aggj(k,l)=-aggj(k,l)
3075 aggj1(k,l)=-aggj1(k,l)
3086 aggi(k,l)=-aggi(k,l)
3087 aggi1(k,l)=-aggi1(k,l)
3088 aggj(k,l)=-aggj(k,l)
3089 aggj1(k,l)=-aggj1(k,l)
3094 IF (wel_loc.gt.0.0d0) THEN
3095 C Contribution to the local-electrostatic energy coming from the i-j pair
3096 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3098 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3100 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3101 & 'eelloc',i,j,eel_loc_ij
3103 eel_loc=eel_loc+eel_loc_ij
3104 C Partial derivatives in virtual-bond dihedral angles gamma
3106 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3107 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3108 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3109 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3110 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3111 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3112 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3114 ggg(l)=agg(l,1)*muij(1)+
3115 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3116 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3117 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3118 cgrad ghalf=0.5d0*ggg(l)
3119 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3120 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3124 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3127 C Remaining derivatives of eello
3129 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3130 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3131 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3132 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3133 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3134 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3135 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3136 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3139 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3142 ghalf=0.5d0*agg(l,k)
3143 aggi(l,k)=aggi(l,k)+ghalf
3144 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3145 aggj(l,k)=aggj(l,k)+ghalf
3148 if (j.eq.nres-1 .and. i.lt.j-2) then
3151 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3156 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3157 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3158 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3159 & .and. num_conti.le.maxconts) then
3160 c write (iout,*) i,j," entered corr"
3162 C Calculate the contact function. The ith column of the array JCONT will
3163 C contain the numbers of atoms that make contacts with the atom I (of numbers
3164 C greater than I). The arrays FACONT and GACONT will contain the values of
3165 C the contact function and its derivative.
3166 c r0ij=1.02D0*rpp(iteli,itelj)
3167 c r0ij=1.11D0*rpp(iteli,itelj)
3168 r0ij=2.20D0*rpp(iteli,itelj)
3169 c r0ij=1.55D0*rpp(iteli,itelj)
3170 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3171 if (fcont.gt.0.0D0) then
3172 num_conti=num_conti+1
3173 if (num_conti.gt.maxconts) then
3174 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3175 & ' will skip next contacts for this conf.'
3177 jcont_hb(num_conti,i)=j
3178 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3179 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3180 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3182 d_cont(num_conti,i)=rij
3183 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3184 C --- Electrostatic-interaction matrix ---
3185 a_chuj(1,1,num_conti,i)=a22
3186 a_chuj(1,2,num_conti,i)=a23
3187 a_chuj(2,1,num_conti,i)=a32
3188 a_chuj(2,2,num_conti,i)=a33
3189 C --- Gradient of rij
3191 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3198 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3199 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3200 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3201 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3202 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3207 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3208 C Calculate contact energies
3210 wij=cosa-3.0D0*cosb*cosg
3213 c fac3=dsqrt(-ael6i)/r0ij**3
3214 fac3=dsqrt(-ael6i)*r3ij
3215 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3216 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3217 if (ees0tmp.gt.0) then
3218 ees0pij=dsqrt(ees0tmp)
3222 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3223 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3224 if (ees0tmp.gt.0) then
3225 ees0mij=dsqrt(ees0tmp)
3230 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3231 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3232 C Diagnostics. Comment out or remove after debugging!
3233 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3234 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3235 c ees0m(num_conti,i)=0.0D0
3237 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3238 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3239 C Angular derivatives of the contact function
3240 ees0pij1=fac3/ees0pij
3241 ees0mij1=fac3/ees0mij
3242 fac3p=-3.0D0*fac3*rrmij
3243 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3244 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3246 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3247 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3248 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3249 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3250 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3251 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3252 ecosap=ecosa1+ecosa2
3253 ecosbp=ecosb1+ecosb2
3254 ecosgp=ecosg1+ecosg2
3255 ecosam=ecosa1-ecosa2
3256 ecosbm=ecosb1-ecosb2
3257 ecosgm=ecosg1-ecosg2
3266 facont_hb(num_conti,i)=fcont
3267 fprimcont=fprimcont/rij
3268 cd facont_hb(num_conti,i)=1.0D0
3269 C Following line is for diagnostics.
3272 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3273 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3276 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3277 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3279 gggp(1)=gggp(1)+ees0pijp*xj
3280 gggp(2)=gggp(2)+ees0pijp*yj
3281 gggp(3)=gggp(3)+ees0pijp*zj
3282 gggm(1)=gggm(1)+ees0mijp*xj
3283 gggm(2)=gggm(2)+ees0mijp*yj
3284 gggm(3)=gggm(3)+ees0mijp*zj
3285 C Derivatives due to the contact function
3286 gacont_hbr(1,num_conti,i)=fprimcont*xj
3287 gacont_hbr(2,num_conti,i)=fprimcont*yj
3288 gacont_hbr(3,num_conti,i)=fprimcont*zj
3290 ghalfp=0.5D0*gggp(k)
3291 ghalfm=0.5D0*gggm(k)
3292 gacontp_hb1(k,num_conti,i)=ghalfp
3293 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3294 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3295 gacontp_hb2(k,num_conti,i)=ghalfp
3296 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3297 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3298 gacontp_hb3(k,num_conti,i)=gggp(k)
3299 gacontm_hb1(k,num_conti,i)=ghalfm
3300 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3301 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3302 gacontm_hb2(k,num_conti,i)=ghalfm
3303 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3304 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3305 gacontm_hb3(k,num_conti,i)=gggm(k)
3307 C Diagnostics. Comment out or remove after debugging!
3309 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3310 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3311 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3312 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3313 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3314 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3317 endif ! num_conti.le.maxconts
3320 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3323 C-----------------------------------------------------------------------------
3324 subroutine eturn3(i,eello_turn3)
3325 C Third- and fourth-order contributions from turns
3326 implicit real*8 (a-h,o-z)
3327 include 'DIMENSIONS'
3328 include 'COMMON.IOUNITS'
3329 include 'COMMON.GEO'
3330 include 'COMMON.VAR'
3331 include 'COMMON.LOCAL'
3332 include 'COMMON.CHAIN'
3333 include 'COMMON.DERIV'
3334 include 'COMMON.INTERACT'
3335 include 'COMMON.CONTACTS'
3336 include 'COMMON.TORSION'
3337 include 'COMMON.VECTORS'
3338 include 'COMMON.FFIELD'
3339 include 'COMMON.CONTROL'
3341 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3342 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3343 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3344 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3345 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3346 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3347 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3350 c write (iout,*) "eturn3",i,j,j1,j2
3355 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3357 C Third-order contributions
3364 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3365 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3366 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3367 call transpose2(auxmat(1,1),auxmat1(1,1))
3368 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3369 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3370 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3371 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3372 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3373 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3374 cd & ' eello_turn3_num',4*eello_turn3_num
3375 C Derivatives in gamma(i)
3376 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3377 call transpose2(auxmat2(1,1),auxmat3(1,1))
3378 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3379 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3380 C Derivatives in gamma(i+1)
3381 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3382 call transpose2(auxmat2(1,1),auxmat3(1,1))
3383 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3384 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3385 & +0.5d0*(pizda(1,1)+pizda(2,2))
3386 C Cartesian derivatives
3388 c ghalf1=0.5d0*agg(l,1)
3389 c ghalf2=0.5d0*agg(l,2)
3390 c ghalf3=0.5d0*agg(l,3)
3391 c ghalf4=0.5d0*agg(l,4)
3392 a_temp(1,1)=aggi(l,1)!+ghalf1
3393 a_temp(1,2)=aggi(l,2)!+ghalf2
3394 a_temp(2,1)=aggi(l,3)!+ghalf3
3395 a_temp(2,2)=aggi(l,4)!+ghalf4
3396 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3397 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3398 & +0.5d0*(pizda(1,1)+pizda(2,2))
3399 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3400 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3401 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3402 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3403 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3404 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3405 & +0.5d0*(pizda(1,1)+pizda(2,2))
3406 a_temp(1,1)=aggj(l,1)!+ghalf1
3407 a_temp(1,2)=aggj(l,2)!+ghalf2
3408 a_temp(2,1)=aggj(l,3)!+ghalf3
3409 a_temp(2,2)=aggj(l,4)!+ghalf4
3410 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3411 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3412 & +0.5d0*(pizda(1,1)+pizda(2,2))
3413 a_temp(1,1)=aggj1(l,1)
3414 a_temp(1,2)=aggj1(l,2)
3415 a_temp(2,1)=aggj1(l,3)
3416 a_temp(2,2)=aggj1(l,4)
3417 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3418 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3419 & +0.5d0*(pizda(1,1)+pizda(2,2))
3423 C-------------------------------------------------------------------------------
3424 subroutine eturn4(i,eello_turn4)
3425 C Third- and fourth-order contributions from turns
3426 implicit real*8 (a-h,o-z)
3427 include 'DIMENSIONS'
3428 include 'COMMON.IOUNITS'
3429 include 'COMMON.GEO'
3430 include 'COMMON.VAR'
3431 include 'COMMON.LOCAL'
3432 include 'COMMON.CHAIN'
3433 include 'COMMON.DERIV'
3434 include 'COMMON.INTERACT'
3435 include 'COMMON.CONTACTS'
3436 include 'COMMON.TORSION'
3437 include 'COMMON.VECTORS'
3438 include 'COMMON.FFIELD'
3439 include 'COMMON.CONTROL'
3441 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3442 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3443 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3444 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3445 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3446 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3447 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3450 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3452 C Fourth-order contributions
3460 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3461 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3462 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3467 iti1=itortyp(itype(i+1))
3468 iti2=itortyp(itype(i+2))
3469 iti3=itortyp(itype(i+3))
3470 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3471 call transpose2(EUg(1,1,i+1),e1t(1,1))
3472 call transpose2(Eug(1,1,i+2),e2t(1,1))
3473 call transpose2(Eug(1,1,i+3),e3t(1,1))
3474 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3475 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3476 s1=scalar2(b1(1,iti2),auxvec(1))
3477 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3478 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3479 s2=scalar2(b1(1,iti1),auxvec(1))
3480 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3481 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3482 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3483 eello_turn4=eello_turn4-(s1+s2+s3)
3484 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3485 & 'eturn4',i,j,-(s1+s2+s3)
3486 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3487 cd & ' eello_turn4_num',8*eello_turn4_num
3488 C Derivatives in gamma(i)
3489 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3490 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3491 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3492 s1=scalar2(b1(1,iti2),auxvec(1))
3493 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3494 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3495 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3496 C Derivatives in gamma(i+1)
3497 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3498 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3499 s2=scalar2(b1(1,iti1),auxvec(1))
3500 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3501 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3502 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3503 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3504 C Derivatives in gamma(i+2)
3505 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3506 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3507 s1=scalar2(b1(1,iti2),auxvec(1))
3508 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3509 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3510 s2=scalar2(b1(1,iti1),auxvec(1))
3511 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3512 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3513 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3514 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3515 C Cartesian derivatives
3516 C Derivatives of this turn contributions in DC(i+2)
3517 if (j.lt.nres-1) then
3519 a_temp(1,1)=agg(l,1)
3520 a_temp(1,2)=agg(l,2)
3521 a_temp(2,1)=agg(l,3)
3522 a_temp(2,2)=agg(l,4)
3523 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3524 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3525 s1=scalar2(b1(1,iti2),auxvec(1))
3526 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3527 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3528 s2=scalar2(b1(1,iti1),auxvec(1))
3529 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3530 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3531 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3533 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3536 C Remaining derivatives of this turn contribution
3538 a_temp(1,1)=aggi(l,1)
3539 a_temp(1,2)=aggi(l,2)
3540 a_temp(2,1)=aggi(l,3)
3541 a_temp(2,2)=aggi(l,4)
3542 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3543 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3544 s1=scalar2(b1(1,iti2),auxvec(1))
3545 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3546 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3547 s2=scalar2(b1(1,iti1),auxvec(1))
3548 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3549 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3550 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3551 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3552 a_temp(1,1)=aggi1(l,1)
3553 a_temp(1,2)=aggi1(l,2)
3554 a_temp(2,1)=aggi1(l,3)
3555 a_temp(2,2)=aggi1(l,4)
3556 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3557 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3558 s1=scalar2(b1(1,iti2),auxvec(1))
3559 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3560 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3561 s2=scalar2(b1(1,iti1),auxvec(1))
3562 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3563 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3564 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3565 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3566 a_temp(1,1)=aggj(l,1)
3567 a_temp(1,2)=aggj(l,2)
3568 a_temp(2,1)=aggj(l,3)
3569 a_temp(2,2)=aggj(l,4)
3570 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3571 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3572 s1=scalar2(b1(1,iti2),auxvec(1))
3573 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3574 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3575 s2=scalar2(b1(1,iti1),auxvec(1))
3576 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3577 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3578 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3579 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3580 a_temp(1,1)=aggj1(l,1)
3581 a_temp(1,2)=aggj1(l,2)
3582 a_temp(2,1)=aggj1(l,3)
3583 a_temp(2,2)=aggj1(l,4)
3584 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3585 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3586 s1=scalar2(b1(1,iti2),auxvec(1))
3587 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3588 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3589 s2=scalar2(b1(1,iti1),auxvec(1))
3590 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3591 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3592 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3593 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3594 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3598 C-----------------------------------------------------------------------------
3599 subroutine vecpr(u,v,w)
3600 implicit real*8(a-h,o-z)
3601 dimension u(3),v(3),w(3)
3602 w(1)=u(2)*v(3)-u(3)*v(2)
3603 w(2)=-u(1)*v(3)+u(3)*v(1)
3604 w(3)=u(1)*v(2)-u(2)*v(1)
3607 C-----------------------------------------------------------------------------
3608 subroutine unormderiv(u,ugrad,unorm,ungrad)
3609 C This subroutine computes the derivatives of a normalized vector u, given
3610 C the derivatives computed without normalization conditions, ugrad. Returns
3613 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3614 double precision vec(3)
3615 double precision scalar
3617 c write (2,*) 'ugrad',ugrad
3620 vec(i)=scalar(ugrad(1,i),u(1))
3622 c write (2,*) 'vec',vec
3625 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3628 c write (2,*) 'ungrad',ungrad
3631 C-----------------------------------------------------------------------------
3632 subroutine escp_soft_sphere(evdw2,evdw2_14)
3634 C This subroutine calculates the excluded-volume interaction energy between
3635 C peptide-group centers and side chains and its gradient in virtual-bond and
3636 C side-chain vectors.
3638 implicit real*8 (a-h,o-z)
3639 include 'DIMENSIONS'
3640 include 'COMMON.GEO'
3641 include 'COMMON.VAR'
3642 include 'COMMON.LOCAL'
3643 include 'COMMON.CHAIN'
3644 include 'COMMON.DERIV'
3645 include 'COMMON.INTERACT'
3646 include 'COMMON.FFIELD'
3647 include 'COMMON.IOUNITS'
3648 include 'COMMON.CONTROL'
3653 cd print '(a)','Enter ESCP'
3654 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3655 do i=iatscp_s,iatscp_e
3657 xi=0.5D0*(c(1,i)+c(1,i+1))
3658 yi=0.5D0*(c(2,i)+c(2,i+1))
3659 zi=0.5D0*(c(3,i)+c(3,i+1))
3661 do iint=1,nscp_gr(i)
3663 do j=iscpstart(i,iint),iscpend(i,iint)
3665 C Uncomment following three lines for SC-p interactions
3669 C Uncomment following three lines for Ca-p interactions
3673 rij=xj*xj+yj*yj+zj*zj
3676 if (rij.lt.r0ijsq) then
3677 evdwij=0.25d0*(rij-r0ijsq)**2
3685 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3691 cd write (iout,*) 'j<i'
3692 C Uncomment following three lines for SC-p interactions
3694 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3697 cd write (iout,*) 'j>i'
3700 C Uncomment following line for SC-p interactions
3701 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3705 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3709 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3710 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3713 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3722 C-----------------------------------------------------------------------------
3723 subroutine escp(evdw2,evdw2_14)
3725 C This subroutine calculates the excluded-volume interaction energy between
3726 C peptide-group centers and side chains and its gradient in virtual-bond and
3727 C side-chain vectors.
3729 implicit real*8 (a-h,o-z)
3730 include 'DIMENSIONS'
3731 include 'COMMON.GEO'
3732 include 'COMMON.VAR'
3733 include 'COMMON.LOCAL'
3734 include 'COMMON.CHAIN'
3735 include 'COMMON.DERIV'
3736 include 'COMMON.INTERACT'
3737 include 'COMMON.FFIELD'
3738 include 'COMMON.IOUNITS'
3739 include 'COMMON.CONTROL'
3743 cd print '(a)','Enter ESCP'
3744 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3745 do i=iatscp_s,iatscp_e
3747 xi=0.5D0*(c(1,i)+c(1,i+1))
3748 yi=0.5D0*(c(2,i)+c(2,i+1))
3749 zi=0.5D0*(c(3,i)+c(3,i+1))
3751 do iint=1,nscp_gr(i)
3753 do j=iscpstart(i,iint),iscpend(i,iint)
3755 C Uncomment following three lines for SC-p interactions
3759 C Uncomment following three lines for Ca-p interactions
3763 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3765 e1=fac*fac*aad(itypj,iteli)
3766 e2=fac*bad(itypj,iteli)
3767 if (iabs(j-i) .le. 2) then
3770 evdw2_14=evdw2_14+e1+e2
3774 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3775 & 'evdw2',i,j,evdwij
3777 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3779 fac=-(evdwij+e1)*rrij
3783 cgrad if (j.lt.i) then
3784 cd write (iout,*) 'j<i'
3785 C Uncomment following three lines for SC-p interactions
3787 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3790 cd write (iout,*) 'j>i'
3792 cgrad ggg(k)=-ggg(k)
3793 C Uncomment following line for SC-p interactions
3794 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3795 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3799 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3801 cgrad kstart=min0(i+1,j)
3802 cgrad kend=max0(i-1,j-1)
3803 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3804 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3805 cgrad do k=kstart,kend
3807 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3811 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3812 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3820 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3821 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
3822 gradx_scp(j,i)=expon*gradx_scp(j,i)
3825 C******************************************************************************
3829 C To save time the factor EXPON has been extracted from ALL components
3830 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3833 C******************************************************************************
3836 C--------------------------------------------------------------------------
3837 subroutine edis(ehpb)
3839 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3841 implicit real*8 (a-h,o-z)
3842 include 'DIMENSIONS'
3843 include 'COMMON.SBRIDGE'
3844 include 'COMMON.CHAIN'
3845 include 'COMMON.DERIV'
3846 include 'COMMON.VAR'
3847 include 'COMMON.INTERACT'
3850 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3851 cd print *,'link_start=',link_start,' link_end=',link_end
3852 if (link_end.eq.0) return
3853 do i=link_start,link_end
3854 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3855 C CA-CA distance used in regularization of structure.
3858 C iii and jjj point to the residues for which the distance is assigned.
3859 if (ii.gt.nres) then
3866 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3867 C distance and angle dependent SS bond potential.
3868 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3869 call ssbond_ene(iii,jjj,eij)
3872 C Calculate the distance between the two points and its difference from the
3876 C Get the force constant corresponding to this distance.
3878 C Calculate the contribution to energy.
3879 ehpb=ehpb+waga*rdis*rdis
3881 C Evaluate gradient.
3884 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3885 cd & ' waga=',waga,' fac=',fac
3887 ggg(j)=fac*(c(j,jj)-c(j,ii))
3889 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3890 C If this is a SC-SC distance, we need to calculate the contributions to the
3891 C Cartesian gradient in the SC vectors (ghpbx).
3894 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3895 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3900 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3908 C--------------------------------------------------------------------------
3909 subroutine ssbond_ene(i,j,eij)
3911 C Calculate the distance and angle dependent SS-bond potential energy
3912 C using a free-energy function derived based on RHF/6-31G** ab initio
3913 C calculations of diethyl disulfide.
3915 C A. Liwo and U. Kozlowska, 11/24/03
3917 implicit real*8 (a-h,o-z)
3918 include 'DIMENSIONS'
3919 include 'COMMON.SBRIDGE'
3920 include 'COMMON.CHAIN'
3921 include 'COMMON.DERIV'
3922 include 'COMMON.LOCAL'
3923 include 'COMMON.INTERACT'
3924 include 'COMMON.VAR'
3925 include 'COMMON.IOUNITS'
3926 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3931 dxi=dc_norm(1,nres+i)
3932 dyi=dc_norm(2,nres+i)
3933 dzi=dc_norm(3,nres+i)
3934 dsci_inv=dsc_inv(itypi)
3936 dscj_inv=dsc_inv(itypj)
3940 dxj=dc_norm(1,nres+j)
3941 dyj=dc_norm(2,nres+j)
3942 dzj=dc_norm(3,nres+j)
3943 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3948 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3949 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3950 om12=dxi*dxj+dyi*dyj+dzi*dzj
3952 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3953 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3959 deltat12=om2-om1+2.0d0
3961 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3962 & +akct*deltad*deltat12
3963 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3964 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3965 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3966 c & " deltat12",deltat12," eij",eij
3967 ed=2*akcm*deltad+akct*deltat12
3969 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3970 eom1=-2*akth*deltat1-pom1-om2*pom2
3971 eom2= 2*akth*deltat2+pom1-om1*pom2
3974 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3977 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3978 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3979 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3980 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3983 C Calculate the components of the gradient in DC and X
3987 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3992 C--------------------------------------------------------------------------
3993 subroutine ebond(estr)
3995 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3997 implicit real*8 (a-h,o-z)
3998 include 'DIMENSIONS'
3999 include 'COMMON.LOCAL'
4000 include 'COMMON.GEO'
4001 include 'COMMON.INTERACT'
4002 include 'COMMON.DERIV'
4003 include 'COMMON.VAR'
4004 include 'COMMON.CHAIN'
4005 include 'COMMON.IOUNITS'
4006 include 'COMMON.NAMES'
4007 include 'COMMON.FFIELD'
4008 include 'COMMON.CONTROL'
4009 include 'COMMON.SETUP'
4010 double precision u(3),ud(3)
4012 do i=ibondp_start,ibondp_end
4013 diff = vbld(i)-vbldp0
4014 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4017 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4019 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4023 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4025 do i=ibond_start,ibond_end
4030 diff=vbld(i+nres)-vbldsc0(1,iti)
4031 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4032 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4033 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4035 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4039 diff=vbld(i+nres)-vbldsc0(j,iti)
4040 ud(j)=aksc(j,iti)*diff
4041 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4055 uprod2=uprod2*u(k)*u(k)
4059 usumsqder=usumsqder+ud(j)*uprod2
4061 estr=estr+uprod/usum
4063 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4071 C--------------------------------------------------------------------------
4072 subroutine ebend(etheta)
4074 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4075 C angles gamma and its derivatives in consecutive thetas and gammas.
4077 implicit real*8 (a-h,o-z)
4078 include 'DIMENSIONS'
4079 include 'COMMON.LOCAL'
4080 include 'COMMON.GEO'
4081 include 'COMMON.INTERACT'
4082 include 'COMMON.DERIV'
4083 include 'COMMON.VAR'
4084 include 'COMMON.CHAIN'
4085 include 'COMMON.IOUNITS'
4086 include 'COMMON.NAMES'
4087 include 'COMMON.FFIELD'
4088 include 'COMMON.CONTROL'
4089 common /calcthet/ term1,term2,termm,diffak,ratak,
4090 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4091 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4092 double precision y(2),z(2)
4094 c time11=dexp(-2*time)
4097 c write (*,'(a,i2)') 'EBEND ICG=',icg
4098 do i=ithet_start,ithet_end
4099 C Zero the energy function and its derivative at 0 or pi.
4100 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4105 if (phii.ne.phii) phii=150.0
4118 if (phii1.ne.phii1) phii1=150.0
4130 C Calculate the "mean" value of theta from the part of the distribution
4131 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4132 C In following comments this theta will be referred to as t_c.
4133 thet_pred_mean=0.0d0
4137 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4139 dthett=thet_pred_mean*ssd
4140 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4141 C Derivatives of the "mean" values in gamma1 and gamma2.
4142 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4143 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4144 if (theta(i).gt.pi-delta) then
4145 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4147 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4148 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4149 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4151 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4153 else if (theta(i).lt.delta) then
4154 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4155 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4156 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4158 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4159 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4162 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4165 etheta=etheta+ethetai
4166 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4168 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4169 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4170 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4172 C Ufff.... We've done all this!!!
4175 C---------------------------------------------------------------------------
4176 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4178 implicit real*8 (a-h,o-z)
4179 include 'DIMENSIONS'
4180 include 'COMMON.LOCAL'
4181 include 'COMMON.IOUNITS'
4182 common /calcthet/ term1,term2,termm,diffak,ratak,
4183 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4184 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4185 C Calculate the contributions to both Gaussian lobes.
4186 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4187 C The "polynomial part" of the "standard deviation" of this part of
4191 sig=sig*thet_pred_mean+polthet(j,it)
4193 C Derivative of the "interior part" of the "standard deviation of the"
4194 C gamma-dependent Gaussian lobe in t_c.
4195 sigtc=3*polthet(3,it)
4197 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4200 C Set the parameters of both Gaussian lobes of the distribution.
4201 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4202 fac=sig*sig+sigc0(it)
4205 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4206 sigsqtc=-4.0D0*sigcsq*sigtc
4207 c print *,i,sig,sigtc,sigsqtc
4208 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4209 sigtc=-sigtc/(fac*fac)
4210 C Following variable is sigma(t_c)**(-2)
4211 sigcsq=sigcsq*sigcsq
4213 sig0inv=1.0D0/sig0i**2
4214 delthec=thetai-thet_pred_mean
4215 delthe0=thetai-theta0i
4216 term1=-0.5D0*sigcsq*delthec*delthec
4217 term2=-0.5D0*sig0inv*delthe0*delthe0
4218 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4219 C NaNs in taking the logarithm. We extract the largest exponent which is added
4220 C to the energy (this being the log of the distribution) at the end of energy
4221 C term evaluation for this virtual-bond angle.
4222 if (term1.gt.term2) then
4224 term2=dexp(term2-termm)
4228 term1=dexp(term1-termm)
4231 C The ratio between the gamma-independent and gamma-dependent lobes of
4232 C the distribution is a Gaussian function of thet_pred_mean too.
4233 diffak=gthet(2,it)-thet_pred_mean
4234 ratak=diffak/gthet(3,it)**2
4235 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4236 C Let's differentiate it in thet_pred_mean NOW.
4238 C Now put together the distribution terms to make complete distribution.
4239 termexp=term1+ak*term2
4240 termpre=sigc+ak*sig0i
4241 C Contribution of the bending energy from this theta is just the -log of
4242 C the sum of the contributions from the two lobes and the pre-exponential
4243 C factor. Simple enough, isn't it?
4244 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4245 C NOW the derivatives!!!
4246 C 6/6/97 Take into account the deformation.
4247 E_theta=(delthec*sigcsq*term1
4248 & +ak*delthe0*sig0inv*term2)/termexp
4249 E_tc=((sigtc+aktc*sig0i)/termpre
4250 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4251 & aktc*term2)/termexp)
4254 c-----------------------------------------------------------------------------
4255 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4256 implicit real*8 (a-h,o-z)
4257 include 'DIMENSIONS'
4258 include 'COMMON.LOCAL'
4259 include 'COMMON.IOUNITS'
4260 common /calcthet/ term1,term2,termm,diffak,ratak,
4261 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4262 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4263 delthec=thetai-thet_pred_mean
4264 delthe0=thetai-theta0i
4265 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4266 t3 = thetai-thet_pred_mean
4270 t14 = t12+t6*sigsqtc
4272 t21 = thetai-theta0i
4278 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4279 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4280 & *(-t12*t9-ak*sig0inv*t27)
4284 C--------------------------------------------------------------------------
4285 subroutine ebend(etheta)
4287 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4288 C angles gamma and its derivatives in consecutive thetas and gammas.
4289 C ab initio-derived potentials from
4290 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4292 implicit real*8 (a-h,o-z)
4293 include 'DIMENSIONS'
4294 include 'COMMON.LOCAL'
4295 include 'COMMON.GEO'
4296 include 'COMMON.INTERACT'
4297 include 'COMMON.DERIV'
4298 include 'COMMON.VAR'
4299 include 'COMMON.CHAIN'
4300 include 'COMMON.IOUNITS'
4301 include 'COMMON.NAMES'
4302 include 'COMMON.FFIELD'
4303 include 'COMMON.CONTROL'
4304 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4305 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4306 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4307 & sinph1ph2(maxdouble,maxdouble)
4308 logical lprn /.false./, lprn1 /.false./
4310 do i=ithet_start,ithet_end
4314 theti2=0.5d0*theta(i)
4315 ityp2=ithetyp(itype(i-1))
4317 coskt(k)=dcos(k*theti2)
4318 sinkt(k)=dsin(k*theti2)
4323 if (phii.ne.phii) phii=150.0
4327 ityp1=ithetyp(itype(i-2))
4329 cosph1(k)=dcos(k*phii)
4330 sinph1(k)=dsin(k*phii)
4343 if (phii1.ne.phii1) phii1=150.0
4348 ityp3=ithetyp(itype(i))
4350 cosph2(k)=dcos(k*phii1)
4351 sinph2(k)=dsin(k*phii1)
4361 ethetai=aa0thet(ityp1,ityp2,ityp3)
4364 ccl=cosph1(l)*cosph2(k-l)
4365 ssl=sinph1(l)*sinph2(k-l)
4366 scl=sinph1(l)*cosph2(k-l)
4367 csl=cosph1(l)*sinph2(k-l)
4368 cosph1ph2(l,k)=ccl-ssl
4369 cosph1ph2(k,l)=ccl+ssl
4370 sinph1ph2(l,k)=scl+csl
4371 sinph1ph2(k,l)=scl-csl
4375 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4376 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4377 write (iout,*) "coskt and sinkt"
4379 write (iout,*) k,coskt(k),sinkt(k)
4383 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4384 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4387 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4388 & " ethetai",ethetai
4391 write (iout,*) "cosph and sinph"
4393 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4395 write (iout,*) "cosph1ph2 and sinph2ph2"
4398 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4399 & sinph1ph2(l,k),sinph1ph2(k,l)
4402 write(iout,*) "ethetai",ethetai
4406 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4407 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4408 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4409 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4410 ethetai=ethetai+sinkt(m)*aux
4411 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4412 dephii=dephii+k*sinkt(m)*(
4413 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4414 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4415 dephii1=dephii1+k*sinkt(m)*(
4416 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4417 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4419 & write (iout,*) "m",m," k",k," bbthet",
4420 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4421 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4422 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4423 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4427 & write(iout,*) "ethetai",ethetai
4431 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4432 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4433 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4434 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4435 ethetai=ethetai+sinkt(m)*aux
4436 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4437 dephii=dephii+l*sinkt(m)*(
4438 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4439 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4440 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4441 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4442 dephii1=dephii1+(k-l)*sinkt(m)*(
4443 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4444 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4445 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4446 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4448 write (iout,*) "m",m," k",k," l",l," ffthet",
4449 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4450 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4451 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4452 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4453 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4454 & cosph1ph2(k,l)*sinkt(m),
4455 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4461 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4462 & i,theta(i)*rad2deg,phii*rad2deg,
4463 & phii1*rad2deg,ethetai
4464 etheta=etheta+ethetai
4465 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4466 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4467 gloc(nphi+i-2,icg)=wang*dethetai
4473 c-----------------------------------------------------------------------------
4474 subroutine esc(escloc)
4475 C Calculate the local energy of a side chain and its derivatives in the
4476 C corresponding virtual-bond valence angles THETA and the spherical angles
4478 implicit real*8 (a-h,o-z)
4479 include 'DIMENSIONS'
4480 include 'COMMON.GEO'
4481 include 'COMMON.LOCAL'
4482 include 'COMMON.VAR'
4483 include 'COMMON.INTERACT'
4484 include 'COMMON.DERIV'
4485 include 'COMMON.CHAIN'
4486 include 'COMMON.IOUNITS'
4487 include 'COMMON.NAMES'
4488 include 'COMMON.FFIELD'
4489 include 'COMMON.CONTROL'
4490 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4491 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4492 common /sccalc/ time11,time12,time112,theti,it,nlobit
4495 c write (iout,'(a)') 'ESC'
4496 do i=loc_start,loc_end
4498 if (it.eq.10) goto 1
4500 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4501 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4502 theti=theta(i+1)-pipol
4507 if (x(2).gt.pi-delta) then
4511 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4513 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4514 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4516 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4517 & ddersc0(1),dersc(1))
4518 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4519 & ddersc0(3),dersc(3))
4521 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4523 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4524 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4525 & dersc0(2),esclocbi,dersc02)
4526 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4528 call splinthet(x(2),0.5d0*delta,ss,ssd)
4533 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4535 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4536 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4538 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4540 c write (iout,*) escloci
4541 else if (x(2).lt.delta) then
4545 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4547 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4548 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4550 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4551 & ddersc0(1),dersc(1))
4552 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4553 & ddersc0(3),dersc(3))
4555 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4557 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4558 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4559 & dersc0(2),esclocbi,dersc02)
4560 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4565 call splinthet(x(2),0.5d0*delta,ss,ssd)
4567 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4569 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4570 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4572 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4573 c write (iout,*) escloci
4575 call enesc(x,escloci,dersc,ddummy,.false.)
4578 escloc=escloc+escloci
4579 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4580 & 'escloc',i,escloci
4581 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4583 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4585 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4586 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4591 C---------------------------------------------------------------------------
4592 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4593 implicit real*8 (a-h,o-z)
4594 include 'DIMENSIONS'
4595 include 'COMMON.GEO'
4596 include 'COMMON.LOCAL'
4597 include 'COMMON.IOUNITS'
4598 common /sccalc/ time11,time12,time112,theti,it,nlobit
4599 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4600 double precision contr(maxlob,-1:1)
4602 c write (iout,*) 'it=',it,' nlobit=',nlobit
4606 if (mixed) ddersc(j)=0.0d0
4610 C Because of periodicity of the dependence of the SC energy in omega we have
4611 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4612 C To avoid underflows, first compute & store the exponents.
4620 z(k)=x(k)-censc(k,j,it)
4625 Axk=Axk+gaussc(l,k,j,it)*z(l)
4631 expfac=expfac+Ax(k,j,iii)*z(k)
4639 C As in the case of ebend, we want to avoid underflows in exponentiation and
4640 C subsequent NaNs and INFs in energy calculation.
4641 C Find the largest exponent
4645 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4649 cd print *,'it=',it,' emin=',emin
4651 C Compute the contribution to SC energy and derivatives
4656 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4657 if(adexp.ne.adexp) adexp=1.0
4660 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4662 cd print *,'j=',j,' expfac=',expfac
4663 escloc_i=escloc_i+expfac
4665 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4669 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4670 & +gaussc(k,2,j,it))*expfac
4677 dersc(1)=dersc(1)/cos(theti)**2
4678 ddersc(1)=ddersc(1)/cos(theti)**2
4681 escloci=-(dlog(escloc_i)-emin)
4683 dersc(j)=dersc(j)/escloc_i
4687 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4692 C------------------------------------------------------------------------------
4693 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4694 implicit real*8 (a-h,o-z)
4695 include 'DIMENSIONS'
4696 include 'COMMON.GEO'
4697 include 'COMMON.LOCAL'
4698 include 'COMMON.IOUNITS'
4699 common /sccalc/ time11,time12,time112,theti,it,nlobit
4700 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4701 double precision contr(maxlob)
4712 z(k)=x(k)-censc(k,j,it)
4718 Axk=Axk+gaussc(l,k,j,it)*z(l)
4724 expfac=expfac+Ax(k,j)*z(k)
4729 C As in the case of ebend, we want to avoid underflows in exponentiation and
4730 C subsequent NaNs and INFs in energy calculation.
4731 C Find the largest exponent
4734 if (emin.gt.contr(j)) emin=contr(j)
4738 C Compute the contribution to SC energy and derivatives
4742 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4743 escloc_i=escloc_i+expfac
4745 dersc(k)=dersc(k)+Ax(k,j)*expfac
4747 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4748 & +gaussc(1,2,j,it))*expfac
4752 dersc(1)=dersc(1)/cos(theti)**2
4753 dersc12=dersc12/cos(theti)**2
4754 escloci=-(dlog(escloc_i)-emin)
4756 dersc(j)=dersc(j)/escloc_i
4758 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4762 c----------------------------------------------------------------------------------
4763 subroutine esc(escloc)
4764 C Calculate the local energy of a side chain and its derivatives in the
4765 C corresponding virtual-bond valence angles THETA and the spherical angles
4766 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4767 C added by Urszula Kozlowska. 07/11/2007
4769 implicit real*8 (a-h,o-z)
4770 include 'DIMENSIONS'
4771 include 'COMMON.GEO'
4772 include 'COMMON.LOCAL'
4773 include 'COMMON.VAR'
4774 include 'COMMON.SCROT'
4775 include 'COMMON.INTERACT'
4776 include 'COMMON.DERIV'
4777 include 'COMMON.CHAIN'
4778 include 'COMMON.IOUNITS'
4779 include 'COMMON.NAMES'
4780 include 'COMMON.FFIELD'
4781 include 'COMMON.CONTROL'
4782 include 'COMMON.VECTORS'
4783 double precision x_prime(3),y_prime(3),z_prime(3)
4784 & , sumene,dsc_i,dp2_i,x(65),
4785 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4786 & de_dxx,de_dyy,de_dzz,de_dt
4787 double precision s1_t,s1_6_t,s2_t,s2_6_t
4789 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4790 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4791 & dt_dCi(3),dt_dCi1(3)
4792 common /sccalc/ time11,time12,time112,theti,it,nlobit
4795 do i=loc_start,loc_end
4796 costtab(i+1) =dcos(theta(i+1))
4797 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4798 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4799 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4800 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4801 cosfac=dsqrt(cosfac2)
4802 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4803 sinfac=dsqrt(sinfac2)
4805 if (it.eq.10) goto 1
4807 C Compute the axes of tghe local cartesian coordinates system; store in
4808 c x_prime, y_prime and z_prime
4815 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4816 C & dc_norm(3,i+nres)
4818 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4819 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4822 z_prime(j) = -uz(j,i-1)
4825 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4826 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4827 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4828 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4829 c & " xy",scalar(x_prime(1),y_prime(1)),
4830 c & " xz",scalar(x_prime(1),z_prime(1)),
4831 c & " yy",scalar(y_prime(1),y_prime(1)),
4832 c & " yz",scalar(y_prime(1),z_prime(1)),
4833 c & " zz",scalar(z_prime(1),z_prime(1))
4835 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4836 C to local coordinate system. Store in xx, yy, zz.
4842 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4843 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4844 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4851 C Compute the energy of the ith side cbain
4853 c write (2,*) "xx",xx," yy",yy," zz",zz
4856 x(j) = sc_parmin(j,it)
4859 Cc diagnostics - remove later
4861 yy1 = dsin(alph(2))*dcos(omeg(2))
4862 zz1 = -dsin(alph(2))*dsin(omeg(2))
4863 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4864 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4866 C," --- ", xx_w,yy_w,zz_w
4869 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4870 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4872 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4873 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4875 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4876 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4877 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4878 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4879 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4881 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4882 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4883 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4884 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4885 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4887 dsc_i = 0.743d0+x(61)
4889 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4890 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4891 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4892 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4893 s1=(1+x(63))/(0.1d0 + dscp1)
4894 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4895 s2=(1+x(65))/(0.1d0 + dscp2)
4896 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4897 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4898 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4899 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4901 c & dscp1,dscp2,sumene
4902 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4903 escloc = escloc + sumene
4904 c write (2,*) "i",i," escloc",sumene,escloc
4907 C This section to check the numerical derivatives of the energy of ith side
4908 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4909 C #define DEBUG in the code to turn it on.
4911 write (2,*) "sumene =",sumene
4915 write (2,*) xx,yy,zz
4916 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4917 de_dxx_num=(sumenep-sumene)/aincr
4919 write (2,*) "xx+ sumene from enesc=",sumenep
4922 write (2,*) xx,yy,zz
4923 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4924 de_dyy_num=(sumenep-sumene)/aincr
4926 write (2,*) "yy+ sumene from enesc=",sumenep
4929 write (2,*) xx,yy,zz
4930 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4931 de_dzz_num=(sumenep-sumene)/aincr
4933 write (2,*) "zz+ sumene from enesc=",sumenep
4934 costsave=cost2tab(i+1)
4935 sintsave=sint2tab(i+1)
4936 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4937 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4938 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4939 de_dt_num=(sumenep-sumene)/aincr
4940 write (2,*) " t+ sumene from enesc=",sumenep
4941 cost2tab(i+1)=costsave
4942 sint2tab(i+1)=sintsave
4943 C End of diagnostics section.
4946 C Compute the gradient of esc
4948 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4949 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4950 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4951 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4952 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4953 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4954 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4955 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4956 pom1=(sumene3*sint2tab(i+1)+sumene1)
4957 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4958 pom2=(sumene4*cost2tab(i+1)+sumene2)
4959 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4960 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4961 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4962 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4964 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4965 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4966 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4968 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4969 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4970 & +(pom1+pom2)*pom_dx
4972 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4975 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4976 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4977 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4979 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4980 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4981 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4982 & +x(59)*zz**2 +x(60)*xx*zz
4983 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4984 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4985 & +(pom1-pom2)*pom_dy
4987 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4990 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4991 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4992 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4993 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4994 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4995 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4996 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4997 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4999 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5002 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5003 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5004 & +pom1*pom_dt1+pom2*pom_dt2
5006 write(2,*), "de_dt = ", de_dt,de_dt_num
5010 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5011 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5012 cosfac2xx=cosfac2*xx
5013 sinfac2yy=sinfac2*yy
5015 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5017 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5019 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5020 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5021 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5022 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5023 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5024 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5025 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5026 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5027 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5028 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5032 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5033 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5036 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5037 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5038 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5040 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5041 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5045 dXX_Ctab(k,i)=dXX_Ci(k)
5046 dXX_C1tab(k,i)=dXX_Ci1(k)
5047 dYY_Ctab(k,i)=dYY_Ci(k)
5048 dYY_C1tab(k,i)=dYY_Ci1(k)
5049 dZZ_Ctab(k,i)=dZZ_Ci(k)
5050 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5051 dXX_XYZtab(k,i)=dXX_XYZ(k)
5052 dYY_XYZtab(k,i)=dYY_XYZ(k)
5053 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5057 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5058 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5059 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5060 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5061 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5063 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5064 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5065 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5066 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5067 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5068 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5069 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5070 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5072 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5073 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5075 C to check gradient call subroutine check_grad
5081 c------------------------------------------------------------------------------
5082 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5084 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5085 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5086 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5087 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5089 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5090 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5092 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5093 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5094 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5095 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5096 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5098 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5099 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5100 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5101 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5102 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5104 dsc_i = 0.743d0+x(61)
5106 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5107 & *(xx*cost2+yy*sint2))
5108 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5109 & *(xx*cost2-yy*sint2))
5110 s1=(1+x(63))/(0.1d0 + dscp1)
5111 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5112 s2=(1+x(65))/(0.1d0 + dscp2)
5113 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5114 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5115 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5120 c------------------------------------------------------------------------------
5121 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5123 C This procedure calculates two-body contact function g(rij) and its derivative:
5126 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5129 C where x=(rij-r0ij)/delta
5131 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5134 double precision rij,r0ij,eps0ij,fcont,fprimcont
5135 double precision x,x2,x4,delta
5139 if (x.lt.-1.0D0) then
5142 else if (x.le.1.0D0) then
5145 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5146 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5153 c------------------------------------------------------------------------------
5154 subroutine splinthet(theti,delta,ss,ssder)
5155 implicit real*8 (a-h,o-z)
5156 include 'DIMENSIONS'
5157 include 'COMMON.VAR'
5158 include 'COMMON.GEO'
5161 if (theti.gt.pipol) then
5162 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5164 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5169 c------------------------------------------------------------------------------
5170 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5172 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5173 double precision ksi,ksi2,ksi3,a1,a2,a3
5174 a1=fprim0*delta/(f1-f0)
5180 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5181 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5184 c------------------------------------------------------------------------------
5185 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5187 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5188 double precision ksi,ksi2,ksi3,a1,a2,a3
5193 a2=3*(f1x-f0x)-2*fprim0x*delta
5194 a3=fprim0x*delta-2*(f1x-f0x)
5195 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5198 C-----------------------------------------------------------------------------
5200 C-----------------------------------------------------------------------------
5201 subroutine etor(etors,edihcnstr)
5202 implicit real*8 (a-h,o-z)
5203 include 'DIMENSIONS'
5204 include 'COMMON.VAR'
5205 include 'COMMON.GEO'
5206 include 'COMMON.LOCAL'
5207 include 'COMMON.TORSION'
5208 include 'COMMON.INTERACT'
5209 include 'COMMON.DERIV'
5210 include 'COMMON.CHAIN'
5211 include 'COMMON.NAMES'
5212 include 'COMMON.IOUNITS'
5213 include 'COMMON.FFIELD'
5214 include 'COMMON.TORCNSTR'
5215 include 'COMMON.CONTROL'
5217 C Set lprn=.true. for debugging
5221 do i=iphi_start,iphi_end
5223 itori=itortyp(itype(i-2))
5224 itori1=itortyp(itype(i-1))
5227 C Proline-Proline pair is a special case...
5228 if (itori.eq.3 .and. itori1.eq.3) then
5229 if (phii.gt.-dwapi3) then
5231 fac=1.0D0/(1.0D0-cosphi)
5232 etorsi=v1(1,3,3)*fac
5233 etorsi=etorsi+etorsi
5234 etors=etors+etorsi-v1(1,3,3)
5235 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5236 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5239 v1ij=v1(j+1,itori,itori1)
5240 v2ij=v2(j+1,itori,itori1)
5243 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5244 if (energy_dec) etors_ii=etors_ii+
5245 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5246 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5250 v1ij=v1(j,itori,itori1)
5251 v2ij=v2(j,itori,itori1)
5254 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5255 if (energy_dec) etors_ii=etors_ii+
5256 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5257 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5260 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5263 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5264 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5265 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5266 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5267 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5269 ! 6/20/98 - dihedral angle constraints
5272 itori=idih_constr(i)
5275 if (difi.gt.drange(i)) then
5277 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5278 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5279 else if (difi.lt.-drange(i)) then
5281 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5282 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5284 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5285 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5287 ! write (iout,*) 'edihcnstr',edihcnstr
5290 c------------------------------------------------------------------------------
5291 subroutine etor_d(etors_d)
5295 c----------------------------------------------------------------------------
5297 subroutine etor(etors,edihcnstr)
5298 implicit real*8 (a-h,o-z)
5299 include 'DIMENSIONS'
5300 include 'COMMON.VAR'
5301 include 'COMMON.GEO'
5302 include 'COMMON.LOCAL'
5303 include 'COMMON.TORSION'
5304 include 'COMMON.INTERACT'
5305 include 'COMMON.DERIV'
5306 include 'COMMON.CHAIN'
5307 include 'COMMON.NAMES'
5308 include 'COMMON.IOUNITS'
5309 include 'COMMON.FFIELD'
5310 include 'COMMON.TORCNSTR'
5311 include 'COMMON.CONTROL'
5313 C Set lprn=.true. for debugging
5317 do i=iphi_start,iphi_end
5319 itori=itortyp(itype(i-2))
5320 itori1=itortyp(itype(i-1))
5323 C Regular cosine and sine terms
5324 do j=1,nterm(itori,itori1)
5325 v1ij=v1(j,itori,itori1)
5326 v2ij=v2(j,itori,itori1)
5329 etors=etors+v1ij*cosphi+v2ij*sinphi
5330 if (energy_dec) etors_ii=etors_ii+
5331 & v1ij*cosphi+v2ij*sinphi
5332 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5336 C E = SUM ----------------------------------- - v1
5337 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5339 cosphi=dcos(0.5d0*phii)
5340 sinphi=dsin(0.5d0*phii)
5341 do j=1,nlor(itori,itori1)
5342 vl1ij=vlor1(j,itori,itori1)
5343 vl2ij=vlor2(j,itori,itori1)
5344 vl3ij=vlor3(j,itori,itori1)
5345 pom=vl2ij*cosphi+vl3ij*sinphi
5346 pom1=1.0d0/(pom*pom+1.0d0)
5347 etors=etors+vl1ij*pom1
5348 if (energy_dec) etors_ii=etors_ii+
5351 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5353 C Subtract the constant term
5354 etors=etors-v0(itori,itori1)
5355 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5356 & 'etor',i,etors_ii-v0(itori,itori1)
5358 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5359 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5360 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5361 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5362 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5364 ! 6/20/98 - dihedral angle constraints
5366 c do i=1,ndih_constr
5367 do i=idihconstr_start,idihconstr_end
5368 itori=idih_constr(i)
5370 difi=pinorm(phii-phi0(i))
5371 if (difi.gt.drange(i)) then
5373 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5374 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5375 else if (difi.lt.-drange(i)) then
5377 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5378 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5382 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5383 cd & rad2deg*phi0(i), rad2deg*drange(i),
5384 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5386 cd write (iout,*) 'edihcnstr',edihcnstr
5389 c----------------------------------------------------------------------------
5390 subroutine etor_d(etors_d)
5391 C 6/23/01 Compute double torsional energy
5392 implicit real*8 (a-h,o-z)
5393 include 'DIMENSIONS'
5394 include 'COMMON.VAR'
5395 include 'COMMON.GEO'
5396 include 'COMMON.LOCAL'
5397 include 'COMMON.TORSION'
5398 include 'COMMON.INTERACT'
5399 include 'COMMON.DERIV'
5400 include 'COMMON.CHAIN'
5401 include 'COMMON.NAMES'
5402 include 'COMMON.IOUNITS'
5403 include 'COMMON.FFIELD'
5404 include 'COMMON.TORCNSTR'
5406 C Set lprn=.true. for debugging
5410 do i=iphid_start,iphid_end
5411 itori=itortyp(itype(i-2))
5412 itori1=itortyp(itype(i-1))
5413 itori2=itortyp(itype(i))
5418 C Regular cosine and sine terms
5419 do j=1,ntermd_1(itori,itori1,itori2)
5420 v1cij=v1c(1,j,itori,itori1,itori2)
5421 v1sij=v1s(1,j,itori,itori1,itori2)
5422 v2cij=v1c(2,j,itori,itori1,itori2)
5423 v2sij=v1s(2,j,itori,itori1,itori2)
5424 cosphi1=dcos(j*phii)
5425 sinphi1=dsin(j*phii)
5426 cosphi2=dcos(j*phii1)
5427 sinphi2=dsin(j*phii1)
5428 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5429 & v2cij*cosphi2+v2sij*sinphi2
5430 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5431 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5433 do k=2,ntermd_2(itori,itori1,itori2)
5435 v1cdij = v2c(k,l,itori,itori1,itori2)
5436 v2cdij = v2c(l,k,itori,itori1,itori2)
5437 v1sdij = v2s(k,l,itori,itori1,itori2)
5438 v2sdij = v2s(l,k,itori,itori1,itori2)
5439 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5440 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5441 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5442 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5443 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5444 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5445 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5446 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5447 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5448 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5451 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5452 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5457 c------------------------------------------------------------------------------
5458 subroutine eback_sc_corr(esccor)
5459 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5460 c conformational states; temporarily implemented as differences
5461 c between UNRES torsional potentials (dependent on three types of
5462 c residues) and the torsional potentials dependent on all 20 types
5463 c of residues computed from AM1 energy surfaces of terminally-blocked
5464 c amino-acid residues.
5465 implicit real*8 (a-h,o-z)
5466 include 'DIMENSIONS'
5467 include 'COMMON.VAR'
5468 include 'COMMON.GEO'
5469 include 'COMMON.LOCAL'
5470 include 'COMMON.TORSION'
5471 include 'COMMON.SCCOR'
5472 include 'COMMON.INTERACT'
5473 include 'COMMON.DERIV'
5474 include 'COMMON.CHAIN'
5475 include 'COMMON.NAMES'
5476 include 'COMMON.IOUNITS'
5477 include 'COMMON.FFIELD'
5478 include 'COMMON.CONTROL'
5480 C Set lprn=.true. for debugging
5483 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5485 do i=iphi_start,iphi_end
5492 v1ij=v1sccor(j,itori,itori1)
5493 v2ij=v2sccor(j,itori,itori1)
5496 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5497 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5500 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5501 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5502 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5503 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5507 c----------------------------------------------------------------------------
5508 subroutine multibody(ecorr)
5509 C This subroutine calculates multi-body contributions to energy following
5510 C the idea of Skolnick et al. If side chains I and J make a contact and
5511 C at the same time side chains I+1 and J+1 make a contact, an extra
5512 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5513 implicit real*8 (a-h,o-z)
5514 include 'DIMENSIONS'
5515 include 'COMMON.IOUNITS'
5516 include 'COMMON.DERIV'
5517 include 'COMMON.INTERACT'
5518 include 'COMMON.CONTACTS'
5519 double precision gx(3),gx1(3)
5522 C Set lprn=.true. for debugging
5526 write (iout,'(a)') 'Contact function values:'
5528 write (iout,'(i2,20(1x,i2,f10.5))')
5529 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5544 num_conti=num_cont(i)
5545 num_conti1=num_cont(i1)
5550 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5551 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5552 cd & ' ishift=',ishift
5553 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5554 C The system gains extra energy.
5555 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5556 endif ! j1==j+-ishift
5565 c------------------------------------------------------------------------------
5566 double precision function esccorr(i,j,k,l,jj,kk)
5567 implicit real*8 (a-h,o-z)
5568 include 'DIMENSIONS'
5569 include 'COMMON.IOUNITS'
5570 include 'COMMON.DERIV'
5571 include 'COMMON.INTERACT'
5572 include 'COMMON.CONTACTS'
5573 double precision gx(3),gx1(3)
5578 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5579 C Calculate the multi-body contribution to energy.
5580 C Calculate multi-body contributions to the gradient.
5581 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5582 cd & k,l,(gacont(m,kk,k),m=1,3)
5584 gx(m) =ekl*gacont(m,jj,i)
5585 gx1(m)=eij*gacont(m,kk,k)
5586 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5587 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5588 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5589 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5593 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5598 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5604 c------------------------------------------------------------------------------
5606 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5607 implicit real*8 (a-h,o-z)
5608 include 'DIMENSIONS'
5609 integer dimen1,dimen2,atom,indx
5610 double precision buffer(dimen1,dimen2)
5611 double precision zapas
5612 common /contacts_hb/ zapas(3,maxconts,maxres,8),
5613 & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5614 & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5615 & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5616 num_kont=num_cont_hb(atom)
5620 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5623 buffer(i,indx+25)=facont_hb(i,atom)
5624 buffer(i,indx+26)=ees0p(i,atom)
5625 buffer(i,indx+27)=ees0m(i,atom)
5626 buffer(i,indx+28)=d_cont(i,atom)
5627 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
5629 buffer(1,indx+30)=dfloat(num_kont)
5632 c------------------------------------------------------------------------------
5633 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5634 implicit real*8 (a-h,o-z)
5635 include 'DIMENSIONS'
5636 integer dimen1,dimen2,atom,indx
5637 double precision buffer(dimen1,dimen2)
5638 double precision zapas
5639 common /contacts_hb/ zapas(3,maxconts,maxres,8),
5640 & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5641 & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5642 & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5643 num_kont=buffer(1,indx+30)
5644 num_kont_old=num_cont_hb(atom)
5645 num_cont_hb(atom)=num_kont+num_kont_old
5650 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5653 facont_hb(ii,atom)=buffer(i,indx+25)
5654 ees0p(ii,atom)=buffer(i,indx+26)
5655 ees0m(ii,atom)=buffer(i,indx+27)
5656 d_cont(i,atom)=buffer(i,indx+28)
5657 jcont_hb(ii,atom)=buffer(i,indx+29)
5661 c------------------------------------------------------------------------------
5663 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5664 C This subroutine calculates multi-body contributions to hydrogen-bonding
5665 implicit real*8 (a-h,o-z)
5666 include 'DIMENSIONS'
5667 include 'COMMON.IOUNITS'
5670 parameter (max_cont=maxconts)
5671 parameter (max_dim=2*(8*3+6))
5672 parameter (msglen1=max_cont*max_dim)
5673 parameter (msglen2=2*msglen1)
5674 integer source,CorrelType,CorrelID,Error
5675 double precision buffer(max_cont,max_dim)
5676 integer status(MPI_STATUS_SIZE)
5678 include 'COMMON.SETUP'
5679 include 'COMMON.FFIELD'
5680 include 'COMMON.DERIV'
5681 include 'COMMON.INTERACT'
5682 include 'COMMON.CONTACTS'
5683 include 'COMMON.CONTROL'
5684 double precision gx(3),gx1(3),time00
5687 C Set lprn=.true. for debugging
5692 if (nfgtasks.le.1) goto 30
5694 write (iout,'(a)') 'Contact function values:'
5696 write (iout,'(2i3,50(1x,i2,f5.2))')
5697 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5698 & j=1,num_cont_hb(i))
5701 C Caution! Following code assumes that electrostatic interactions concerning
5702 C a given atom are split among at most two processors!
5712 c write (*,*) 'MyRank',MyRank,' mm',mm
5715 c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5716 if (fg_rank.gt.0) then
5717 C Send correlation contributions to the preceding processor
5719 nn=num_cont_hb(iatel_s)
5720 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5721 c write (*,*) 'The BUFFER array:'
5723 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5725 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5727 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5728 C Clear the contacts of the atom passed to the neighboring processor
5729 nn=num_cont_hb(iatel_s+1)
5731 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5733 num_cont_hb(iatel_s)=0
5735 cd write (iout,*) 'Processor ',fg_rank,MyRank,
5736 cd & ' is sending correlation contribution to processor',fg_rank-1,
5737 cd & ' msglen=',msglen
5738 c write (*,*) 'Processor ',fg_rank,MyRank,
5739 c & ' is sending correlation contribution to processor',fg_rank-1,
5740 c & ' msglen=',msglen,' CorrelType=',CorrelType
5742 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5743 & CorrelType,FG_COMM,IERROR)
5744 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5745 cd write (iout,*) 'Processor ',fg_rank,
5746 cd & ' has sent correlation contribution to processor',fg_rank-1,
5747 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5748 c write (*,*) 'Processor ',fg_rank,
5749 c & ' has sent correlation contribution to processor',fg_rank-1,
5750 c & ' msglen=',msglen,' CorrelID=',CorrelID
5752 endif ! (fg_rank.gt.0)
5756 c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5757 if (fg_rank.lt.nfgtasks-1) then
5758 C Receive correlation contributions from the next processor
5760 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5761 cd write (iout,*) 'Processor',fg_rank,
5762 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5763 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5764 c write (*,*) 'Processor',fg_rank,
5765 c &' is receiving correlation contribution from processor',fg_rank+1,
5766 c & ' msglen=',msglen,' CorrelType=',CorrelType
5769 do while (nbytes.le.0)
5770 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5771 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5773 c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
5774 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5775 & fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5776 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5777 c write (*,*) 'Processor',fg_rank,
5778 c &' has received correlation contribution from processor',fg_rank+1,
5779 c & ' msglen=',msglen,' nbytes=',nbytes
5780 c write (*,*) 'The received BUFFER array:'
5782 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
5784 if (msglen.eq.msglen1) then
5785 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5786 else if (msglen.eq.msglen2) then
5787 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5788 call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5791 & 'ERROR!!!! message length changed while processing correlations.'
5793 & 'ERROR!!!! message length changed while processing correlations.'
5794 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5795 endif ! msglen.eq.msglen1
5796 endif ! fg_rank.lt.nfgtasks-1
5803 write (iout,'(a)') 'Contact function values:'
5805 write (iout,'(2i3,50(1x,i2,f5.2))')
5806 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5807 & j=1,num_cont_hb(i))
5811 C Remove the loop below after debugging !!!
5818 C Calculate the local-electrostatic correlation terms
5819 do i=iatel_s,iatel_e+1
5821 num_conti=num_cont_hb(i)
5822 num_conti1=num_cont_hb(i+1)
5827 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5828 c & ' jj=',jj,' kk=',kk
5829 if (j1.eq.j+1 .or. j1.eq.j-1) then
5830 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5831 C The system gains extra energy.
5832 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5833 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5834 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5836 else if (j1.eq.j) then
5837 C Contacts I-J and I-(J+1) occur simultaneously.
5838 C The system loses extra energy.
5839 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5844 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5845 c & ' jj=',jj,' kk=',kk
5847 C Contacts I-J and (I+1)-J occur simultaneously.
5848 C The system loses extra energy.
5849 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5856 c------------------------------------------------------------------------------
5857 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5859 C This subroutine calculates multi-body contributions to hydrogen-bonding
5860 implicit real*8 (a-h,o-z)
5861 include 'DIMENSIONS'
5862 include 'COMMON.IOUNITS'
5865 parameter (max_cont=maxconts)
5866 parameter (max_dim=2*(8*3+6))
5867 c parameter (msglen1=max_cont*max_dim*4)
5868 parameter (msglen1=max_cont*max_dim/2)
5869 parameter (msglen2=2*msglen1)
5870 integer source,CorrelType,CorrelID,Error
5871 double precision buffer(max_cont,max_dim)
5872 integer status(MPI_STATUS_SIZE)
5874 include 'COMMON.SETUP'
5875 include 'COMMON.FFIELD'
5876 include 'COMMON.DERIV'
5877 include 'COMMON.INTERACT'
5878 include 'COMMON.CONTACTS'
5879 include 'COMMON.CONTROL'
5880 double precision gx(3),gx1(3)
5882 C Set lprn=.true. for debugging
5888 if (fgProcs.le.1) goto 30
5890 write (iout,'(a)') 'Contact function values:'
5892 write (iout,'(2i3,50(1x,i2,f5.2))')
5893 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5894 & j=1,num_cont_hb(i))
5897 C Caution! Following code assumes that electrostatic interactions concerning
5898 C a given atom are split among at most two processors!
5908 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5911 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5912 if (MyRank.gt.0) then
5913 C Send correlation contributions to the preceding processor
5915 nn=num_cont_hb(iatel_s)
5916 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5917 cd write (iout,*) 'The BUFFER array:'
5919 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5921 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5923 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5924 C Clear the contacts of the atom passed to the neighboring processor
5925 nn=num_cont_hb(iatel_s+1)
5927 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5929 num_cont_hb(iatel_s)=0
5931 cd write (*,*) 'Processor ',fg_rank,MyRank,
5932 cd & ' is sending correlation contribution to processor',fg_rank-1,
5933 cd & ' msglen=',msglen
5934 cd write (*,*) 'Processor ',MyID,MyRank,
5935 cd & ' is sending correlation contribution to processor',fg_rank-1,
5936 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5938 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5939 & CorrelType,FG_COMM,IERROR)
5940 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5941 cd write (*,*) 'Processor ',fg_rank,MyRank,
5942 cd & ' has sent correlation contribution to processor',fg_rank-1,
5943 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5944 cd write (*,*) 'Processor ',fg_rank,
5945 cd & ' has sent correlation contribution to processor',fg_rank-1,
5946 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5948 endif ! (MyRank.gt.0)
5952 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5953 if (fg_rank.lt.nfgtasks-1) then
5954 C Receive correlation contributions from the next processor
5956 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5957 cd write (iout,*) 'Processor',fg_rank,
5958 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5959 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5960 cd write (*,*) 'Processor',fg_rank,
5961 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5962 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5965 do while (nbytes.le.0)
5966 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5967 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5969 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5970 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5971 & fg_rank+1,CorrelType,status,IERROR)
5972 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5973 cd write (iout,*) 'Processor',fg_rank,
5974 cd & ' has received correlation contribution from processor',fg_rank+1,
5975 cd & ' msglen=',msglen,' nbytes=',nbytes
5976 cd write (iout,*) 'The received BUFFER array:'
5978 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5980 if (msglen.eq.msglen1) then
5981 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5982 else if (msglen.eq.msglen2) then
5983 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5984 call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5987 & 'ERROR!!!! message length changed while processing correlations.'
5989 & 'ERROR!!!! message length changed while processing correlations.'
5990 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5991 endif ! msglen.eq.msglen1
5992 endif ! fg_rank.lt.nfgtasks-1
5999 write (iout,'(a)') 'Contact function values:'
6001 write (iout,'(2i3,50(1x,i2,f5.2))')
6002 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6003 & j=1,num_cont_hb(i))
6009 C Remove the loop below after debugging !!!
6016 C Calculate the dipole-dipole interaction energies
6017 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6018 do i=iatel_s,iatel_e+1
6019 num_conti=num_cont_hb(i)
6028 C Calculate the local-electrostatic correlation terms
6029 do i=iatel_s,iatel_e+1
6031 num_conti=num_cont_hb(i)
6032 num_conti1=num_cont_hb(i+1)
6037 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6038 c & ' jj=',jj,' kk=',kk
6039 if (j1.eq.j+1 .or. j1.eq.j-1) then
6040 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6041 C The system gains extra energy.
6043 sqd1=dsqrt(d_cont(jj,i))
6044 sqd2=dsqrt(d_cont(kk,i1))
6045 sred_geom = sqd1*sqd2
6046 IF (sred_geom.lt.cutoff_corr) THEN
6047 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6049 cd write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6050 cd & ' jj=',jj,' kk=',kk
6051 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6052 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6054 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6055 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6058 cd write (iout,*) 'sred_geom=',sred_geom,
6059 cd & ' ekont=',ekont,' fprim=',fprimcont
6060 call calc_eello(i,j,i+1,j1,jj,kk)
6061 if (wcorr4.gt.0.0d0)
6062 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6063 if (energy_dec.and.wcorr4.gt.0.0d0)
6064 1 write (iout,'(a6,2i5,0pf7.3)')
6065 2 'ecorr4',i,j,eello4(i,j,i+1,j1,jj,kk)
6066 if (wcorr5.gt.0.0d0)
6067 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6068 if (energy_dec.and.wcorr5.gt.0.0d0)
6069 1 write (iout,'(a6,2i5,0pf7.3)')
6070 2 'ecorr5',i,j,eello5(i,j,i+1,j1,jj,kk)
6071 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6072 cd write(2,*)'ijkl',i,j,i+1,j1
6073 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6074 & .or. wturn6.eq.0.0d0))then
6075 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6076 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6077 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6078 1 'ecorr6',i,j,eello6(i,j,i+1,j1,jj,kk)
6079 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6080 cd & 'ecorr6=',ecorr6
6081 cd write (iout,'(4e15.5)') sred_geom,
6082 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6083 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6084 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6085 else if (wturn6.gt.0.0d0
6086 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6087 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6088 eturn6=eturn6+eello_turn6(i,jj,kk)
6089 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6090 1 'eturn6',i,j,eello_turn6(i,jj,kk)
6091 cd write (2,*) 'multibody_eello:eturn6',eturn6
6095 else if (j1.eq.j) then
6096 C Contacts I-J and I-(J+1) occur simultaneously.
6097 C The system loses extra energy.
6098 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6103 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6104 c & ' jj=',jj,' kk=',kk
6106 C Contacts I-J and (I+1)-J occur simultaneously.
6107 C The system loses extra energy.
6108 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6115 c------------------------------------------------------------------------------
6116 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6117 implicit real*8 (a-h,o-z)
6118 include 'DIMENSIONS'
6119 include 'COMMON.IOUNITS'
6120 include 'COMMON.DERIV'
6121 include 'COMMON.INTERACT'
6122 include 'COMMON.CONTACTS'
6123 double precision gx(3),gx1(3)
6133 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6134 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6135 C Following 4 lines for diagnostics.
6140 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6142 c write (iout,*)'Contacts have occurred for peptide groups',
6143 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6144 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6145 C Calculate the multi-body contribution to energy.
6146 ecorr=ecorr+ekont*ees
6147 C Calculate multi-body contributions to the gradient.
6149 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6150 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6151 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6152 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6153 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6154 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6155 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6156 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6157 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6158 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6159 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6160 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6161 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6162 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6166 gradcorr(ll,m)=gradcorr(ll,m)+
6167 & ees*ekl*gacont_hbr(ll,jj,i)-
6168 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6169 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6174 gradcorr(ll,m)=gradcorr(ll,m)+
6175 & ees*eij*gacont_hbr(ll,kk,k)-
6176 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6177 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6184 C---------------------------------------------------------------------------
6185 subroutine dipole(i,j,jj)
6186 implicit real*8 (a-h,o-z)
6187 include 'DIMENSIONS'
6188 include 'COMMON.IOUNITS'
6189 include 'COMMON.CHAIN'
6190 include 'COMMON.FFIELD'
6191 include 'COMMON.DERIV'
6192 include 'COMMON.INTERACT'
6193 include 'COMMON.CONTACTS'
6194 include 'COMMON.TORSION'
6195 include 'COMMON.VAR'
6196 include 'COMMON.GEO'
6197 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6199 iti1 = itortyp(itype(i+1))
6200 if (j.lt.nres-1) then
6201 itj1 = itortyp(itype(j+1))
6206 dipi(iii,1)=Ub2(iii,i)
6207 dipderi(iii)=Ub2der(iii,i)
6208 dipi(iii,2)=b1(iii,iti1)
6209 dipj(iii,1)=Ub2(iii,j)
6210 dipderj(iii)=Ub2der(iii,j)
6211 dipj(iii,2)=b1(iii,itj1)
6215 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6218 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6225 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6229 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6234 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6235 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6237 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6239 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6241 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6246 C---------------------------------------------------------------------------
6247 subroutine calc_eello(i,j,k,l,jj,kk)
6249 C This subroutine computes matrices and vectors needed to calculate
6250 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6252 implicit real*8 (a-h,o-z)
6253 include 'DIMENSIONS'
6254 include 'COMMON.IOUNITS'
6255 include 'COMMON.CHAIN'
6256 include 'COMMON.DERIV'
6257 include 'COMMON.INTERACT'
6258 include 'COMMON.CONTACTS'
6259 include 'COMMON.TORSION'
6260 include 'COMMON.VAR'
6261 include 'COMMON.GEO'
6262 include 'COMMON.FFIELD'
6263 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6264 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6267 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6268 cd & ' jj=',jj,' kk=',kk
6269 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6272 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6273 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6276 call transpose2(aa1(1,1),aa1t(1,1))
6277 call transpose2(aa2(1,1),aa2t(1,1))
6280 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6281 & aa1tder(1,1,lll,kkk))
6282 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6283 & aa2tder(1,1,lll,kkk))
6287 C parallel orientation of the two CA-CA-CA frames.
6289 iti=itortyp(itype(i))
6293 itk1=itortyp(itype(k+1))
6294 itj=itortyp(itype(j))
6295 if (l.lt.nres-1) then
6296 itl1=itortyp(itype(l+1))
6300 C A1 kernel(j+1) A2T
6302 cd write (iout,'(3f10.5,5x,3f10.5)')
6303 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6305 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6306 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6307 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6308 C Following matrices are needed only for 6-th order cumulants
6309 IF (wcorr6.gt.0.0d0) THEN
6310 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6311 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6312 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6313 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6314 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6315 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6316 & ADtEAderx(1,1,1,1,1,1))
6318 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6319 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6320 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6321 & ADtEA1derx(1,1,1,1,1,1))
6323 C End 6-th order cumulants
6326 cd write (2,*) 'In calc_eello6'
6328 cd write (2,*) 'iii=',iii
6330 cd write (2,*) 'kkk=',kkk
6332 cd write (2,'(3(2f10.5),5x)')
6333 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6338 call transpose2(EUgder(1,1,k),auxmat(1,1))
6339 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6340 call transpose2(EUg(1,1,k),auxmat(1,1))
6341 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6342 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6346 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6347 & EAEAderx(1,1,lll,kkk,iii,1))
6351 C A1T kernel(i+1) A2
6352 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6353 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6354 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6355 C Following matrices are needed only for 6-th order cumulants
6356 IF (wcorr6.gt.0.0d0) THEN
6357 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6358 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6359 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6360 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6361 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6362 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6363 & ADtEAderx(1,1,1,1,1,2))
6364 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6365 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6366 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6367 & ADtEA1derx(1,1,1,1,1,2))
6369 C End 6-th order cumulants
6370 call transpose2(EUgder(1,1,l),auxmat(1,1))
6371 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6372 call transpose2(EUg(1,1,l),auxmat(1,1))
6373 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6374 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6378 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6379 & EAEAderx(1,1,lll,kkk,iii,2))
6384 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6385 C They are needed only when the fifth- or the sixth-order cumulants are
6387 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6388 call transpose2(AEA(1,1,1),auxmat(1,1))
6389 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6390 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6391 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6392 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6393 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6394 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6395 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6396 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6397 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6398 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6399 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6400 call transpose2(AEA(1,1,2),auxmat(1,1))
6401 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6402 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6403 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6404 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6405 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6406 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6407 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6408 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6409 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6410 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6411 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6412 C Calculate the Cartesian derivatives of the vectors.
6416 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6417 call matvec2(auxmat(1,1),b1(1,iti),
6418 & AEAb1derx(1,lll,kkk,iii,1,1))
6419 call matvec2(auxmat(1,1),Ub2(1,i),
6420 & AEAb2derx(1,lll,kkk,iii,1,1))
6421 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6422 & AEAb1derx(1,lll,kkk,iii,2,1))
6423 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6424 & AEAb2derx(1,lll,kkk,iii,2,1))
6425 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6426 call matvec2(auxmat(1,1),b1(1,itj),
6427 & AEAb1derx(1,lll,kkk,iii,1,2))
6428 call matvec2(auxmat(1,1),Ub2(1,j),
6429 & AEAb2derx(1,lll,kkk,iii,1,2))
6430 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6431 & AEAb1derx(1,lll,kkk,iii,2,2))
6432 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6433 & AEAb2derx(1,lll,kkk,iii,2,2))
6440 C Antiparallel orientation of the two CA-CA-CA frames.
6442 iti=itortyp(itype(i))
6446 itk1=itortyp(itype(k+1))
6447 itl=itortyp(itype(l))
6448 itj=itortyp(itype(j))
6449 if (j.lt.nres-1) then
6450 itj1=itortyp(itype(j+1))
6454 C A2 kernel(j-1)T A1T
6455 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6456 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6457 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6458 C Following matrices are needed only for 6-th order cumulants
6459 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6460 & j.eq.i+4 .and. l.eq.i+3)) THEN
6461 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6462 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6463 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6464 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6465 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6466 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6467 & ADtEAderx(1,1,1,1,1,1))
6468 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6469 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6470 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6471 & ADtEA1derx(1,1,1,1,1,1))
6473 C End 6-th order cumulants
6474 call transpose2(EUgder(1,1,k),auxmat(1,1))
6475 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6476 call transpose2(EUg(1,1,k),auxmat(1,1))
6477 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6478 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6482 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6483 & EAEAderx(1,1,lll,kkk,iii,1))
6487 C A2T kernel(i+1)T A1
6488 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6489 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6490 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6491 C Following matrices are needed only for 6-th order cumulants
6492 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6493 & j.eq.i+4 .and. l.eq.i+3)) THEN
6494 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6495 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6496 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6497 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6498 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6499 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6500 & ADtEAderx(1,1,1,1,1,2))
6501 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6502 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6503 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6504 & ADtEA1derx(1,1,1,1,1,2))
6506 C End 6-th order cumulants
6507 call transpose2(EUgder(1,1,j),auxmat(1,1))
6508 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6509 call transpose2(EUg(1,1,j),auxmat(1,1))
6510 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6511 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6515 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6516 & EAEAderx(1,1,lll,kkk,iii,2))
6521 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6522 C They are needed only when the fifth- or the sixth-order cumulants are
6524 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6525 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6526 call transpose2(AEA(1,1,1),auxmat(1,1))
6527 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6528 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6529 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6530 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6531 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6532 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6533 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6534 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6535 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6536 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6537 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6538 call transpose2(AEA(1,1,2),auxmat(1,1))
6539 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6540 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6541 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6542 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6543 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6544 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6545 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6546 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6547 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6548 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6549 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6550 C Calculate the Cartesian derivatives of the vectors.
6554 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6555 call matvec2(auxmat(1,1),b1(1,iti),
6556 & AEAb1derx(1,lll,kkk,iii,1,1))
6557 call matvec2(auxmat(1,1),Ub2(1,i),
6558 & AEAb2derx(1,lll,kkk,iii,1,1))
6559 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6560 & AEAb1derx(1,lll,kkk,iii,2,1))
6561 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6562 & AEAb2derx(1,lll,kkk,iii,2,1))
6563 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6564 call matvec2(auxmat(1,1),b1(1,itl),
6565 & AEAb1derx(1,lll,kkk,iii,1,2))
6566 call matvec2(auxmat(1,1),Ub2(1,l),
6567 & AEAb2derx(1,lll,kkk,iii,1,2))
6568 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6569 & AEAb1derx(1,lll,kkk,iii,2,2))
6570 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6571 & AEAb2derx(1,lll,kkk,iii,2,2))
6580 C---------------------------------------------------------------------------
6581 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6582 & KK,KKderg,AKA,AKAderg,AKAderx)
6586 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6587 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6588 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6593 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6595 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6598 cd if (lprn) write (2,*) 'In kernel'
6600 cd if (lprn) write (2,*) 'kkk=',kkk
6602 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6603 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6605 cd write (2,*) 'lll=',lll
6606 cd write (2,*) 'iii=1'
6608 cd write (2,'(3(2f10.5),5x)')
6609 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6612 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6613 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6615 cd write (2,*) 'lll=',lll
6616 cd write (2,*) 'iii=2'
6618 cd write (2,'(3(2f10.5),5x)')
6619 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6626 C---------------------------------------------------------------------------
6627 double precision function eello4(i,j,k,l,jj,kk)
6628 implicit real*8 (a-h,o-z)
6629 include 'DIMENSIONS'
6630 include 'COMMON.IOUNITS'
6631 include 'COMMON.CHAIN'
6632 include 'COMMON.DERIV'
6633 include 'COMMON.INTERACT'
6634 include 'COMMON.CONTACTS'
6635 include 'COMMON.TORSION'
6636 include 'COMMON.VAR'
6637 include 'COMMON.GEO'
6638 double precision pizda(2,2),ggg1(3),ggg2(3)
6639 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6643 cd print *,'eello4:',i,j,k,l,jj,kk
6644 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6645 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6646 cold eij=facont_hb(jj,i)
6647 cold ekl=facont_hb(kk,k)
6649 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6650 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6651 gcorr_loc(k-1)=gcorr_loc(k-1)
6652 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6654 gcorr_loc(l-1)=gcorr_loc(l-1)
6655 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6657 gcorr_loc(j-1)=gcorr_loc(j-1)
6658 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6663 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6664 & -EAEAderx(2,2,lll,kkk,iii,1)
6665 cd derx(lll,kkk,iii)=0.0d0
6669 cd gcorr_loc(l-1)=0.0d0
6670 cd gcorr_loc(j-1)=0.0d0
6671 cd gcorr_loc(k-1)=0.0d0
6673 cd write (iout,*)'Contacts have occurred for peptide groups',
6674 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6675 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6676 if (j.lt.nres-1) then
6683 if (l.lt.nres-1) then
6691 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6692 ggg1(ll)=eel4*g_contij(ll,1)
6693 ggg2(ll)=eel4*g_contij(ll,2)
6694 ghalf=0.5d0*ggg1(ll)
6696 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6697 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6698 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6699 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6700 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6701 ghalf=0.5d0*ggg2(ll)
6703 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6704 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6705 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6706 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6711 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6712 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6717 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6718 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6724 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6729 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6733 cd write (2,*) iii,gcorr_loc(iii)
6736 cd write (2,*) 'ekont',ekont
6737 cd write (iout,*) 'eello4',ekont*eel4
6740 C---------------------------------------------------------------------------
6741 double precision function eello5(i,j,k,l,jj,kk)
6742 implicit real*8 (a-h,o-z)
6743 include 'DIMENSIONS'
6744 include 'COMMON.IOUNITS'
6745 include 'COMMON.CHAIN'
6746 include 'COMMON.DERIV'
6747 include 'COMMON.INTERACT'
6748 include 'COMMON.CONTACTS'
6749 include 'COMMON.TORSION'
6750 include 'COMMON.VAR'
6751 include 'COMMON.GEO'
6752 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6753 double precision ggg1(3),ggg2(3)
6754 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6759 C /l\ / \ \ / \ / \ / C
6760 C / \ / \ \ / \ / \ / C
6761 C j| o |l1 | o | o| o | | o |o C
6762 C \ |/k\| |/ \| / |/ \| |/ \| C
6763 C \i/ \ / \ / / \ / \ C
6765 C (I) (II) (III) (IV) C
6767 C eello5_1 eello5_2 eello5_3 eello5_4 C
6769 C Antiparallel chains C
6772 C /j\ / \ \ / \ / \ / C
6773 C / \ / \ \ / \ / \ / C
6774 C j1| o |l | o | o| o | | o |o C
6775 C \ |/k\| |/ \| / |/ \| |/ \| C
6776 C \i/ \ / \ / / \ / \ C
6778 C (I) (II) (III) (IV) C
6780 C eello5_1 eello5_2 eello5_3 eello5_4 C
6782 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6784 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6785 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6790 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6792 itk=itortyp(itype(k))
6793 itl=itortyp(itype(l))
6794 itj=itortyp(itype(j))
6799 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6800 cd & eel5_3_num,eel5_4_num)
6804 derx(lll,kkk,iii)=0.0d0
6808 cd eij=facont_hb(jj,i)
6809 cd ekl=facont_hb(kk,k)
6811 cd write (iout,*)'Contacts have occurred for peptide groups',
6812 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6814 C Contribution from the graph I.
6815 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6816 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6817 call transpose2(EUg(1,1,k),auxmat(1,1))
6818 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6819 vv(1)=pizda(1,1)-pizda(2,2)
6820 vv(2)=pizda(1,2)+pizda(2,1)
6821 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6822 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6823 C Explicit gradient in virtual-dihedral angles.
6824 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6825 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6826 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6827 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6828 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6829 vv(1)=pizda(1,1)-pizda(2,2)
6830 vv(2)=pizda(1,2)+pizda(2,1)
6831 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6832 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6833 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6834 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6835 vv(1)=pizda(1,1)-pizda(2,2)
6836 vv(2)=pizda(1,2)+pizda(2,1)
6838 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6839 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6840 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6842 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6843 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6844 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6846 C Cartesian gradient
6850 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6852 vv(1)=pizda(1,1)-pizda(2,2)
6853 vv(2)=pizda(1,2)+pizda(2,1)
6854 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6855 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6856 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6862 C Contribution from graph II
6863 call transpose2(EE(1,1,itk),auxmat(1,1))
6864 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6865 vv(1)=pizda(1,1)+pizda(2,2)
6866 vv(2)=pizda(2,1)-pizda(1,2)
6867 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6868 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6869 C Explicit gradient in virtual-dihedral angles.
6870 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6871 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6872 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6873 vv(1)=pizda(1,1)+pizda(2,2)
6874 vv(2)=pizda(2,1)-pizda(1,2)
6876 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6877 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6878 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6880 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6881 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6882 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6884 C Cartesian gradient
6888 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6890 vv(1)=pizda(1,1)+pizda(2,2)
6891 vv(2)=pizda(2,1)-pizda(1,2)
6892 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6893 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6894 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6902 C Parallel orientation
6903 C Contribution from graph III
6904 call transpose2(EUg(1,1,l),auxmat(1,1))
6905 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6906 vv(1)=pizda(1,1)-pizda(2,2)
6907 vv(2)=pizda(1,2)+pizda(2,1)
6908 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6909 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6910 C Explicit gradient in virtual-dihedral angles.
6911 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6912 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6913 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6914 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6915 vv(1)=pizda(1,1)-pizda(2,2)
6916 vv(2)=pizda(1,2)+pizda(2,1)
6917 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6918 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6919 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6920 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6921 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6922 vv(1)=pizda(1,1)-pizda(2,2)
6923 vv(2)=pizda(1,2)+pizda(2,1)
6924 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6925 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6926 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6927 C Cartesian gradient
6931 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6933 vv(1)=pizda(1,1)-pizda(2,2)
6934 vv(2)=pizda(1,2)+pizda(2,1)
6935 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6936 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6937 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6942 C Contribution from graph IV
6944 call transpose2(EE(1,1,itl),auxmat(1,1))
6945 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6946 vv(1)=pizda(1,1)+pizda(2,2)
6947 vv(2)=pizda(2,1)-pizda(1,2)
6948 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6949 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6950 C Explicit gradient in virtual-dihedral angles.
6951 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6952 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6953 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6954 vv(1)=pizda(1,1)+pizda(2,2)
6955 vv(2)=pizda(2,1)-pizda(1,2)
6956 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6957 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6958 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6959 C Cartesian gradient
6963 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6965 vv(1)=pizda(1,1)+pizda(2,2)
6966 vv(2)=pizda(2,1)-pizda(1,2)
6967 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6968 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6969 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6974 C Antiparallel orientation
6975 C Contribution from graph III
6977 call transpose2(EUg(1,1,j),auxmat(1,1))
6978 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6979 vv(1)=pizda(1,1)-pizda(2,2)
6980 vv(2)=pizda(1,2)+pizda(2,1)
6981 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6982 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6983 C Explicit gradient in virtual-dihedral angles.
6984 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6985 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6986 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6987 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6988 vv(1)=pizda(1,1)-pizda(2,2)
6989 vv(2)=pizda(1,2)+pizda(2,1)
6990 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6991 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6992 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6993 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6994 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6995 vv(1)=pizda(1,1)-pizda(2,2)
6996 vv(2)=pizda(1,2)+pizda(2,1)
6997 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6998 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6999 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7000 C Cartesian gradient
7004 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7006 vv(1)=pizda(1,1)-pizda(2,2)
7007 vv(2)=pizda(1,2)+pizda(2,1)
7008 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7009 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7010 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7015 C Contribution from graph IV
7017 call transpose2(EE(1,1,itj),auxmat(1,1))
7018 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7019 vv(1)=pizda(1,1)+pizda(2,2)
7020 vv(2)=pizda(2,1)-pizda(1,2)
7021 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7022 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7023 C Explicit gradient in virtual-dihedral angles.
7024 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7025 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7026 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7027 vv(1)=pizda(1,1)+pizda(2,2)
7028 vv(2)=pizda(2,1)-pizda(1,2)
7029 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7030 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7031 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7032 C Cartesian gradient
7036 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7038 vv(1)=pizda(1,1)+pizda(2,2)
7039 vv(2)=pizda(2,1)-pizda(1,2)
7040 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7041 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7042 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7048 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7049 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7050 cd write (2,*) 'ijkl',i,j,k,l
7051 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7052 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7054 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7055 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7056 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7057 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7058 if (j.lt.nres-1) then
7065 if (l.lt.nres-1) then
7075 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7077 ggg1(ll)=eel5*g_contij(ll,1)
7078 ggg2(ll)=eel5*g_contij(ll,2)
7079 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7080 ghalf=0.5d0*ggg1(ll)
7082 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7083 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7084 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7085 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7086 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7087 ghalf=0.5d0*ggg2(ll)
7089 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7090 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7091 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7092 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7097 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7098 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7103 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7104 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7110 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7115 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7119 cd write (2,*) iii,g_corr5_loc(iii)
7122 cd write (2,*) 'ekont',ekont
7123 cd write (iout,*) 'eello5',ekont*eel5
7126 c--------------------------------------------------------------------------
7127 double precision function eello6(i,j,k,l,jj,kk)
7128 implicit real*8 (a-h,o-z)
7129 include 'DIMENSIONS'
7130 include 'COMMON.IOUNITS'
7131 include 'COMMON.CHAIN'
7132 include 'COMMON.DERIV'
7133 include 'COMMON.INTERACT'
7134 include 'COMMON.CONTACTS'
7135 include 'COMMON.TORSION'
7136 include 'COMMON.VAR'
7137 include 'COMMON.GEO'
7138 include 'COMMON.FFIELD'
7139 double precision ggg1(3),ggg2(3)
7140 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7145 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7153 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7154 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7158 derx(lll,kkk,iii)=0.0d0
7162 cd eij=facont_hb(jj,i)
7163 cd ekl=facont_hb(kk,k)
7169 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7170 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7171 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7172 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7173 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7174 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7176 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7177 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7178 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7179 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7180 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7181 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7185 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7187 C If turn contributions are considered, they will be handled separately.
7188 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7189 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7190 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7191 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7192 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7193 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7194 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7196 if (j.lt.nres-1) then
7203 if (l.lt.nres-1) then
7211 ggg1(ll)=eel6*g_contij(ll,1)
7212 ggg2(ll)=eel6*g_contij(ll,2)
7213 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7214 ghalf=0.5d0*ggg1(ll)
7216 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7217 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7218 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7219 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7220 ghalf=0.5d0*ggg2(ll)
7221 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7223 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7224 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7225 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7226 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7231 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7232 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7237 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7238 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7244 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7249 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7253 cd write (2,*) iii,g_corr6_loc(iii)
7256 cd write (2,*) 'ekont',ekont
7257 cd write (iout,*) 'eello6',ekont*eel6
7260 c--------------------------------------------------------------------------
7261 double precision function eello6_graph1(i,j,k,l,imat,swap)
7262 implicit real*8 (a-h,o-z)
7263 include 'DIMENSIONS'
7264 include 'COMMON.IOUNITS'
7265 include 'COMMON.CHAIN'
7266 include 'COMMON.DERIV'
7267 include 'COMMON.INTERACT'
7268 include 'COMMON.CONTACTS'
7269 include 'COMMON.TORSION'
7270 include 'COMMON.VAR'
7271 include 'COMMON.GEO'
7272 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7276 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7278 C Parallel Antiparallel
7284 C \ j|/k\| / \ |/k\|l /
7289 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7290 itk=itortyp(itype(k))
7291 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7292 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7293 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7294 call transpose2(EUgC(1,1,k),auxmat(1,1))
7295 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7296 vv1(1)=pizda1(1,1)-pizda1(2,2)
7297 vv1(2)=pizda1(1,2)+pizda1(2,1)
7298 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7299 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7300 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7301 s5=scalar2(vv(1),Dtobr2(1,i))
7302 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7303 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7304 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7305 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7306 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7307 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7308 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7309 & +scalar2(vv(1),Dtobr2der(1,i)))
7310 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7311 vv1(1)=pizda1(1,1)-pizda1(2,2)
7312 vv1(2)=pizda1(1,2)+pizda1(2,1)
7313 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7314 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7316 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7317 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7318 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7319 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7320 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7322 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7323 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7324 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7325 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7326 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7328 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7329 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7330 vv1(1)=pizda1(1,1)-pizda1(2,2)
7331 vv1(2)=pizda1(1,2)+pizda1(2,1)
7332 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7333 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7334 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7335 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7344 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7345 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7346 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7347 call transpose2(EUgC(1,1,k),auxmat(1,1))
7348 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7350 vv1(1)=pizda1(1,1)-pizda1(2,2)
7351 vv1(2)=pizda1(1,2)+pizda1(2,1)
7352 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7353 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7354 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7355 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7356 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7357 s5=scalar2(vv(1),Dtobr2(1,i))
7358 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7364 c----------------------------------------------------------------------------
7365 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7366 implicit real*8 (a-h,o-z)
7367 include 'DIMENSIONS'
7368 include 'COMMON.IOUNITS'
7369 include 'COMMON.CHAIN'
7370 include 'COMMON.DERIV'
7371 include 'COMMON.INTERACT'
7372 include 'COMMON.CONTACTS'
7373 include 'COMMON.TORSION'
7374 include 'COMMON.VAR'
7375 include 'COMMON.GEO'
7377 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7378 & auxvec1(2),auxvec2(1),auxmat1(2,2)
7381 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7383 C Parallel Antiparallel
7394 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7395 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7396 C AL 7/4/01 s1 would occur in the sixth-order moment,
7397 C but not in a cluster cumulant
7399 s1=dip(1,jj,i)*dip(1,kk,k)
7401 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7402 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7403 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7404 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7405 call transpose2(EUg(1,1,k),auxmat(1,1))
7406 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7407 vv(1)=pizda(1,1)-pizda(2,2)
7408 vv(2)=pizda(1,2)+pizda(2,1)
7409 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7410 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7412 eello6_graph2=-(s1+s2+s3+s4)
7414 eello6_graph2=-(s2+s3+s4)
7417 C Derivatives in gamma(i-1)
7420 s1=dipderg(1,jj,i)*dip(1,kk,k)
7422 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7423 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7424 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7425 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7427 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7429 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7431 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7433 C Derivatives in gamma(k-1)
7435 s1=dip(1,jj,i)*dipderg(1,kk,k)
7437 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7438 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7439 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7440 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7441 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7442 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7443 vv(1)=pizda(1,1)-pizda(2,2)
7444 vv(2)=pizda(1,2)+pizda(2,1)
7445 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7447 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7449 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7451 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7452 C Derivatives in gamma(j-1) or gamma(l-1)
7455 s1=dipderg(3,jj,i)*dip(1,kk,k)
7457 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7458 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7459 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7460 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7461 vv(1)=pizda(1,1)-pizda(2,2)
7462 vv(2)=pizda(1,2)+pizda(2,1)
7463 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7466 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7468 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7471 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7472 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7474 C Derivatives in gamma(l-1) or gamma(j-1)
7477 s1=dip(1,jj,i)*dipderg(3,kk,k)
7479 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7480 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7481 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7482 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7483 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7484 vv(1)=pizda(1,1)-pizda(2,2)
7485 vv(2)=pizda(1,2)+pizda(2,1)
7486 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7489 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7491 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7494 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7495 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7497 C Cartesian derivatives.
7499 write (2,*) 'In eello6_graph2'
7501 write (2,*) 'iii=',iii
7503 write (2,*) 'kkk=',kkk
7505 write (2,'(3(2f10.5),5x)')
7506 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7516 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7518 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7521 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7523 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7524 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7526 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7527 call transpose2(EUg(1,1,k),auxmat(1,1))
7528 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7530 vv(1)=pizda(1,1)-pizda(2,2)
7531 vv(2)=pizda(1,2)+pizda(2,1)
7532 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7533 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7535 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7537 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7540 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7542 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7549 c----------------------------------------------------------------------------
7550 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7551 implicit real*8 (a-h,o-z)
7552 include 'DIMENSIONS'
7553 include 'COMMON.IOUNITS'
7554 include 'COMMON.CHAIN'
7555 include 'COMMON.DERIV'
7556 include 'COMMON.INTERACT'
7557 include 'COMMON.CONTACTS'
7558 include 'COMMON.TORSION'
7559 include 'COMMON.VAR'
7560 include 'COMMON.GEO'
7561 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7563 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7565 C Parallel Antiparallel
7576 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7578 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7579 C energy moment and not to the cluster cumulant.
7580 iti=itortyp(itype(i))
7581 if (j.lt.nres-1) then
7582 itj1=itortyp(itype(j+1))
7586 itk=itortyp(itype(k))
7587 itk1=itortyp(itype(k+1))
7588 if (l.lt.nres-1) then
7589 itl1=itortyp(itype(l+1))
7594 s1=dip(4,jj,i)*dip(4,kk,k)
7596 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7597 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7598 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7599 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7600 call transpose2(EE(1,1,itk),auxmat(1,1))
7601 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7602 vv(1)=pizda(1,1)+pizda(2,2)
7603 vv(2)=pizda(2,1)-pizda(1,2)
7604 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7605 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7607 eello6_graph3=-(s1+s2+s3+s4)
7609 eello6_graph3=-(s2+s3+s4)
7612 C Derivatives in gamma(k-1)
7613 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7614 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7615 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7616 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7617 C Derivatives in gamma(l-1)
7618 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7619 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7620 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7621 vv(1)=pizda(1,1)+pizda(2,2)
7622 vv(2)=pizda(2,1)-pizda(1,2)
7623 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7624 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7625 C Cartesian derivatives.
7631 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7633 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7636 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7638 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7639 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7641 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7642 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7644 vv(1)=pizda(1,1)+pizda(2,2)
7645 vv(2)=pizda(2,1)-pizda(1,2)
7646 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7648 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7650 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7653 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7655 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7657 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7663 c----------------------------------------------------------------------------
7664 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7665 implicit real*8 (a-h,o-z)
7666 include 'DIMENSIONS'
7667 include 'COMMON.IOUNITS'
7668 include 'COMMON.CHAIN'
7669 include 'COMMON.DERIV'
7670 include 'COMMON.INTERACT'
7671 include 'COMMON.CONTACTS'
7672 include 'COMMON.TORSION'
7673 include 'COMMON.VAR'
7674 include 'COMMON.GEO'
7675 include 'COMMON.FFIELD'
7676 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7677 & auxvec1(2),auxmat1(2,2)
7679 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7681 C Parallel Antiparallel
7692 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7694 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7695 C energy moment and not to the cluster cumulant.
7696 cd write (2,*) 'eello_graph4: wturn6',wturn6
7697 iti=itortyp(itype(i))
7698 itj=itortyp(itype(j))
7699 if (j.lt.nres-1) then
7700 itj1=itortyp(itype(j+1))
7704 itk=itortyp(itype(k))
7705 if (k.lt.nres-1) then
7706 itk1=itortyp(itype(k+1))
7710 itl=itortyp(itype(l))
7711 if (l.lt.nres-1) then
7712 itl1=itortyp(itype(l+1))
7716 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7717 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7718 cd & ' itl',itl,' itl1',itl1
7721 s1=dip(3,jj,i)*dip(3,kk,k)
7723 s1=dip(2,jj,j)*dip(2,kk,l)
7726 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7727 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7729 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7730 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7732 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7733 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7735 call transpose2(EUg(1,1,k),auxmat(1,1))
7736 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7737 vv(1)=pizda(1,1)-pizda(2,2)
7738 vv(2)=pizda(2,1)+pizda(1,2)
7739 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7740 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7742 eello6_graph4=-(s1+s2+s3+s4)
7744 eello6_graph4=-(s2+s3+s4)
7746 C Derivatives in gamma(i-1)
7750 s1=dipderg(2,jj,i)*dip(3,kk,k)
7752 s1=dipderg(4,jj,j)*dip(2,kk,l)
7755 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7757 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7758 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7760 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7761 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7763 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7764 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7765 cd write (2,*) 'turn6 derivatives'
7767 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7769 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7773 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7775 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7779 C Derivatives in gamma(k-1)
7782 s1=dip(3,jj,i)*dipderg(2,kk,k)
7784 s1=dip(2,jj,j)*dipderg(4,kk,l)
7787 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7788 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7790 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7791 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7793 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7794 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7796 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7797 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7798 vv(1)=pizda(1,1)-pizda(2,2)
7799 vv(2)=pizda(2,1)+pizda(1,2)
7800 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7801 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7803 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7805 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7809 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7811 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7814 C Derivatives in gamma(j-1) or gamma(l-1)
7815 if (l.eq.j+1 .and. l.gt.1) then
7816 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7817 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7818 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7819 vv(1)=pizda(1,1)-pizda(2,2)
7820 vv(2)=pizda(2,1)+pizda(1,2)
7821 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7822 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7823 else if (j.gt.1) then
7824 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7825 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7826 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7827 vv(1)=pizda(1,1)-pizda(2,2)
7828 vv(2)=pizda(2,1)+pizda(1,2)
7829 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7830 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7831 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7833 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7836 C Cartesian derivatives.
7843 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7845 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7849 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7851 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7855 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7857 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7859 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7860 & b1(1,itj1),auxvec(1))
7861 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7863 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7864 & b1(1,itl1),auxvec(1))
7865 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7867 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7869 vv(1)=pizda(1,1)-pizda(2,2)
7870 vv(2)=pizda(2,1)+pizda(1,2)
7871 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7873 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7875 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7878 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7881 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7884 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7886 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7888 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7892 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7894 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7897 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7899 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7907 c----------------------------------------------------------------------------
7908 double precision function eello_turn6(i,jj,kk)
7909 implicit real*8 (a-h,o-z)
7910 include 'DIMENSIONS'
7911 include 'COMMON.IOUNITS'
7912 include 'COMMON.CHAIN'
7913 include 'COMMON.DERIV'
7914 include 'COMMON.INTERACT'
7915 include 'COMMON.CONTACTS'
7916 include 'COMMON.TORSION'
7917 include 'COMMON.VAR'
7918 include 'COMMON.GEO'
7919 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7920 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7922 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7923 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7924 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7925 C the respective energy moment and not to the cluster cumulant.
7934 iti=itortyp(itype(i))
7935 itk=itortyp(itype(k))
7936 itk1=itortyp(itype(k+1))
7937 itl=itortyp(itype(l))
7938 itj=itortyp(itype(j))
7939 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7940 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7941 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7946 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7948 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7952 derx_turn(lll,kkk,iii)=0.0d0
7959 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7961 cd write (2,*) 'eello6_5',eello6_5
7963 call transpose2(AEA(1,1,1),auxmat(1,1))
7964 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7965 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7966 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7968 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7969 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7970 s2 = scalar2(b1(1,itk),vtemp1(1))
7972 call transpose2(AEA(1,1,2),atemp(1,1))
7973 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7974 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7975 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7977 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7978 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7979 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7981 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7982 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7983 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7984 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7985 ss13 = scalar2(b1(1,itk),vtemp4(1))
7986 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7988 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7994 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7995 C Derivatives in gamma(i+2)
7999 call transpose2(AEA(1,1,1),auxmatd(1,1))
8000 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8001 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8002 call transpose2(AEAderg(1,1,2),atempd(1,1))
8003 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8004 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8006 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8007 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8008 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8014 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8015 C Derivatives in gamma(i+3)
8017 call transpose2(AEA(1,1,1),auxmatd(1,1))
8018 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8019 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8020 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8022 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8023 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8024 s2d = scalar2(b1(1,itk),vtemp1d(1))
8026 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8027 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8029 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8031 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8032 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8033 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8041 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8042 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8044 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8045 & -0.5d0*ekont*(s2d+s12d)
8047 C Derivatives in gamma(i+4)
8048 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8049 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8050 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8052 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8053 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8054 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8062 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8064 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8066 C Derivatives in gamma(i+5)
8068 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8069 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8070 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8072 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8073 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8074 s2d = scalar2(b1(1,itk),vtemp1d(1))
8076 call transpose2(AEA(1,1,2),atempd(1,1))
8077 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8078 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8080 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8081 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8083 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8084 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8085 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8093 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8094 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8096 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8097 & -0.5d0*ekont*(s2d+s12d)
8099 C Cartesian derivatives
8104 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8105 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8106 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8108 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8109 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8111 s2d = scalar2(b1(1,itk),vtemp1d(1))
8113 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8114 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8115 s8d = -(atempd(1,1)+atempd(2,2))*
8116 & scalar2(cc(1,1,itl),vtemp2(1))
8118 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8120 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8121 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8128 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8131 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8135 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8136 & - 0.5d0*(s8d+s12d)
8138 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8147 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8149 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8150 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8151 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8152 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8153 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8155 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8156 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8157 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8161 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8162 cd & 16*eel_turn6_num
8164 if (j.lt.nres-1) then
8171 if (l.lt.nres-1) then
8179 ggg1(ll)=eel_turn6*g_contij(ll,1)
8180 ggg2(ll)=eel_turn6*g_contij(ll,2)
8181 ghalf=0.5d0*ggg1(ll)
8183 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8184 & +ekont*derx_turn(ll,2,1)
8185 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8186 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8187 & +ekont*derx_turn(ll,4,1)
8188 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8189 ghalf=0.5d0*ggg2(ll)
8191 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8192 & +ekont*derx_turn(ll,2,2)
8193 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8194 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8195 & +ekont*derx_turn(ll,4,2)
8196 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8201 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8206 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8212 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8217 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8221 cd write (2,*) iii,g_corr6_loc(iii)
8223 eello_turn6=ekont*eel_turn6
8224 cd write (2,*) 'ekont',ekont
8225 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8229 C-----------------------------------------------------------------------------
8230 double precision function scalar(u,v)
8231 !DIR$ INLINEALWAYS scalar
8233 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8236 double precision u(3),v(3)
8237 cd double precision sc
8245 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8248 crc-------------------------------------------------
8249 SUBROUTINE MATVEC2(A1,V1,V2)
8250 !DIR$ INLINEALWAYS MATVEC2
8252 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8254 implicit real*8 (a-h,o-z)
8255 include 'DIMENSIONS'
8256 DIMENSION A1(2,2),V1(2),V2(2)
8260 c 3 VI=VI+A1(I,K)*V1(K)
8264 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8265 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8270 C---------------------------------------
8271 SUBROUTINE MATMAT2(A1,A2,A3)
8273 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8275 implicit real*8 (a-h,o-z)
8276 include 'DIMENSIONS'
8277 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8278 c DIMENSION AI3(2,2)
8282 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8288 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8289 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8290 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8291 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8299 c-------------------------------------------------------------------------
8300 double precision function scalar2(u,v)
8301 !DIR$ INLINEALWAYS scalar2
8303 double precision u(2),v(2)
8306 scalar2=u(1)*v(1)+u(2)*v(2)
8310 C-----------------------------------------------------------------------------
8312 subroutine transpose2(a,at)
8313 !DIR$ INLINEALWAYS transpose2
8315 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8318 double precision a(2,2),at(2,2)
8325 c--------------------------------------------------------------------------
8326 subroutine transpose(n,a,at)
8329 double precision a(n,n),at(n,n)
8337 C---------------------------------------------------------------------------
8338 subroutine prodmat3(a1,a2,kk,transp,prod)
8339 !DIR$ INLINEALWAYS prodmat3
8341 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8345 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8347 crc double precision auxmat(2,2),prod_(2,2)
8350 crc call transpose2(kk(1,1),auxmat(1,1))
8351 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8352 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8354 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8355 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8356 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8357 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8358 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8359 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8360 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8361 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8364 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8365 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8367 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8368 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8369 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8370 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8371 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8372 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8373 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8374 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8377 c call transpose2(a2(1,1),a2t(1,1))
8380 crc print *,((prod_(i,j),i=1,2),j=1,2)
8381 crc print *,((prod(i,j),i=1,2),j=1,2)