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
248 c print *,"Processor",myrank," computed Uconstr"
254 energia(2)=evdw2-evdw2_14
271 energia(8)=eello_turn3
272 energia(9)=eello_turn4
279 energia(19)=edihcnstr
281 energia(20)=Uconst+Uconst_back
283 c print *," Processor",myrank," calls SUM_ENERGY"
284 call sum_energy(energia,.true.)
285 c print *," Processor",myrank," left SUM_ENERGY"
288 c-------------------------------------------------------------------------------
289 subroutine sum_energy(energia,reduce)
290 implicit real*8 (a-h,o-z)
295 cMS$ATTRIBUTES C :: proc_proc
301 include 'COMMON.SETUP'
302 include 'COMMON.IOUNITS'
303 double precision energia(0:n_ene),enebuff(0:n_ene+1)
304 include 'COMMON.FFIELD'
305 include 'COMMON.DERIV'
306 include 'COMMON.INTERACT'
307 include 'COMMON.SBRIDGE'
308 include 'COMMON.CHAIN'
310 include 'COMMON.CONTROL'
311 include 'COMMON.TIME1'
314 if (nfgtasks.gt.1 .and. reduce) then
316 write (iout,*) "energies before REDUCE"
317 call enerprint(energia)
321 enebuff(i)=energia(i)
324 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
325 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
327 write (iout,*) "energies after REDUCE"
328 call enerprint(energia)
331 time_Reduce=time_Reduce+MPI_Wtime()-time00
333 if (fg_rank.eq.0) then
337 evdw2=energia(2)+energia(18)
353 eello_turn3=energia(8)
354 eello_turn4=energia(9)
361 edihcnstr=energia(19)
366 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
367 & +wang*ebe+wtor*etors+wscloc*escloc
368 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
369 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
370 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
371 & +wbond*estr+Uconst+wsccor*esccor
373 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
374 & +wang*ebe+wtor*etors+wscloc*escloc
375 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
376 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
377 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
378 & +wbond*estr+Uconst+wsccor*esccor
384 if (isnan(etot).ne.0) energia(0)=1.0d+99
386 if (isnan(etot)) energia(0)=1.0d+99
391 idumm=proc_proc(etot,i)
393 call proc_proc(etot,i)
395 if(i.eq.1)energia(0)=1.0d+99
402 c-------------------------------------------------------------------------------
403 subroutine sum_gradient
404 implicit real*8 (a-h,o-z)
409 cMS$ATTRIBUTES C :: proc_proc
414 double precision gradbufc(3,maxres),gradbufx(3,maxres),
417 include 'COMMON.SETUP'
418 include 'COMMON.IOUNITS'
419 include 'COMMON.FFIELD'
420 include 'COMMON.DERIV'
421 include 'COMMON.INTERACT'
422 include 'COMMON.SBRIDGE'
423 include 'COMMON.CHAIN'
425 include 'COMMON.CONTROL'
426 include 'COMMON.TIME1'
427 include 'COMMON.MAXGRAD'
429 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
430 C in virtual-bond-vector coordinates
432 write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
434 write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
435 & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
444 gvdwc(k,i)=gvdwc(k,i)+gvdwc(k,j)
445 gvdwc_scp(k,i)=gvdwc_scp(k,i)+gvdwc_scp(k,j)
451 gelc(k,i)=gelc(k,i)+0.5d0*gelc_long(k,i)
452 gvdwpp(k,i)=0.5d0*gvdwpp(k,i)
453 c gel_loc(k,i)=gel_loc(k,i)+0.5d0*gel_loc_long(k,i)
454 gvdwc_scp(k,i)=gvdwc_scp(k,i)+0.5d0*gvdwc_scpp(k,i)
458 gelc(k,i)=gelc(k,i)+gelc_long(k,j)
459 gvdwpp(k,i)=gvdwpp(k,i)+gvdwpp(k,j)
460 c if (i.lt.nres-2) then
461 c gel_loc(k,i)=gel_loc(k,i)+gel_loc_long(k,j)
463 c gel_loc(k,i)=gel_loc(k,i)+gel_loc_long_j2(k,j)
465 gvdwc_scp(k,i)=gvdwc_scp(k,i)+gvdwc_scpp(k,j)
471 gel_loc(k,i)=gel_loc(k,i)+0.5d0*gel_loc_long(k,i)
475 c if (i.lt.nres-2) then
476 gel_loc(k,i)=gel_loc(k,i)+gel_loc_long(k,j)
478 c gel_loc(k,i)=gel_loc(k,i)+gel_loc_long_j2(k,j)
484 gvdwc_scp(k,nres)=0.0d0
487 gel_loc(k,nres)=0.0d0
490 C Sum up the components of the Cartesian gradient.
495 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
496 & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
498 & wstrain*ghpbc(j,i)+
499 & wcorr*gradcorr(j,i)+
500 & wel_loc*gel_loc(j,i)+
501 & wturn3*gcorr3_turn(j,i)+
502 & wturn4*gcorr4_turn(j,i)+
503 & wcorr5*gradcorr5(j,i)+
504 & wcorr6*gradcorr6(j,i)+
505 & wturn6*gcorr6_turn(j,i)+
506 & wsccor*gsccorc(j,i)
507 & +wscloc*gscloc(j,i)
508 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
510 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
511 & wsccor*gsccorx(j,i)
512 & +wscloc*gsclocx(j,i)
518 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
519 & welec*gelc(j,i)+wstrain*ghpbc(j,i)+
521 & wcorr*gradcorr(j,i)+
522 & wel_loc*gel_loc(j,i)+
523 & wturn3*gcorr3_turn(j,i)+
524 & wturn4*gcorr4_turn(j,i)+
525 & wcorr5*gradcorr5(j,i)+
526 & wcorr6*gradcorr6(j,i)+
527 & wturn6*gcorr6_turn(j,i)+
528 & wsccor*gsccorc(j,i)
529 & +wscloc*gscloc(j,i)
530 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
532 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
533 & wsccor*gsccorx(j,i)
534 & +wscloc*gsclocx(j,i)
539 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
540 & +wcorr5*g_corr5_loc(i)
541 & +wcorr6*g_corr6_loc(i)
542 & +wturn4*gel_loc_turn4(i)
543 & +wturn3*gel_loc_turn3(i)
544 & +wturn6*gel_loc_turn6(i)
545 & +wel_loc*gel_loc_loc(i)
546 & +wsccor*gsccor_loc(i)
549 if (nfgtasks.gt.1) then
552 gradbufc(j,i)=gradc(j,i,icg)
553 gradbufx(j,i)=gradx(j,i,icg)
557 glocbuf(i)=gloc(i,icg)
559 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
560 if (fg_rank.eq.0) call MPI_Bcast(1,1,MPI_INTEGER,
561 & king,FG_COMM,IERROR)
563 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
564 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
565 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
566 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
567 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
568 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
569 time_reduce=time_reduce+MPI_Wtime()-time00
572 if (gnorm_check) then
574 c Compute the maximum elements of the gradient
584 gcorr3_turn_max=0.0d0
585 gcorr4_turn_max=0.0d0
588 gcorr6_turn_max=0.0d0
598 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
599 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
600 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
601 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
602 & gvdwc_scp_max=gvdwc_scp_norm
603 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
604 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
605 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
606 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
607 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
608 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
609 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
610 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
611 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
612 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
613 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
614 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
615 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
617 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
618 & gcorr3_turn_max=gcorr3_turn_norm
619 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
621 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
622 & gcorr4_turn_max=gcorr4_turn_norm
623 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
624 if (gradcorr5_norm.gt.gradcorr5_max)
625 & gradcorr5_max=gradcorr5_norm
626 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
627 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
628 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
630 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
631 & gcorr6_turn_max=gcorr6_turn_norm
632 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
633 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
634 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
635 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
636 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
637 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
638 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
639 if (gradx_scp_norm.gt.gradx_scp_max)
640 & gradx_scp_max=gradx_scp_norm
641 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
642 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
643 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
644 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
645 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
646 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
647 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
648 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
652 open(istat,file=statname,position="append")
654 open(istat,file=statname,access="append")
656 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
657 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
658 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
659 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
660 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
661 & gsccorx_max,gsclocx_max
663 if (gvdwc_max.gt.1.0d4) then
664 write (iout,*) "gvdwc gvdwx gradb gradbx"
666 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
667 & gradb(j,i),gradbx(j,i),j=1,3)
669 call pdbout(0.0d0,'cipiszcze',iout)
675 write (iout,*) "gradc gradx gloc"
677 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
678 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
683 c-------------------------------------------------------------------------------
684 subroutine rescale_weights(t_bath)
685 implicit real*8 (a-h,o-z)
687 include 'COMMON.IOUNITS'
688 include 'COMMON.FFIELD'
689 include 'COMMON.SBRIDGE'
690 double precision kfac /2.4d0/
691 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
693 c facT=2*temp0/(t_bath+temp0)
694 if (rescale_mode.eq.0) then
700 else if (rescale_mode.eq.1) then
701 facT=kfac/(kfac-1.0d0+t_bath/temp0)
702 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
703 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
704 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
705 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
706 else if (rescale_mode.eq.2) then
712 facT=licznik/dlog(dexp(x)+dexp(-x))
713 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
714 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
715 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
716 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
718 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
719 write (*,*) "Wrong RESCALE_MODE",rescale_mode
721 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
725 welec=weights(3)*fact
726 wcorr=weights(4)*fact3
727 wcorr5=weights(5)*fact4
728 wcorr6=weights(6)*fact5
729 wel_loc=weights(7)*fact2
730 wturn3=weights(8)*fact2
731 wturn4=weights(9)*fact3
732 wturn6=weights(10)*fact5
733 wtor=weights(13)*fact
734 wtor_d=weights(14)*fact2
735 wsccor=weights(21)*fact
739 C------------------------------------------------------------------------
740 subroutine enerprint(energia)
741 implicit real*8 (a-h,o-z)
743 include 'COMMON.IOUNITS'
744 include 'COMMON.FFIELD'
745 include 'COMMON.SBRIDGE'
747 double precision energia(0:n_ene)
752 evdw2=energia(2)+energia(18)
764 eello_turn3=energia(8)
765 eello_turn4=energia(9)
766 eello_turn6=energia(10)
772 edihcnstr=energia(19)
777 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
778 & estr,wbond,ebe,wang,
779 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
781 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
782 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
785 10 format (/'Virtual-chain energies:'//
786 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
787 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
788 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
789 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
790 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
791 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
792 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
793 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
794 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
795 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
796 & ' (SS bridges & dist. cnstr.)'/
797 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
798 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
799 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
800 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
801 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
802 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
803 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
804 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
805 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
806 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
807 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
808 & 'ETOT= ',1pE16.6,' (total)')
810 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
811 & estr,wbond,ebe,wang,
812 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
814 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
815 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
816 & ebr*nss,Uconst,etot
817 10 format (/'Virtual-chain energies:'//
818 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
819 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
820 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
821 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
822 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
823 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
824 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
825 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
826 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
827 & ' (SS bridges & dist. cnstr.)'/
828 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
829 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
830 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
831 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
832 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
833 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
834 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
835 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
836 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
837 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
838 & 'UCONST=',1pE16.6,' (Constraint energy)'/
839 & 'ETOT= ',1pE16.6,' (total)')
843 C-----------------------------------------------------------------------
846 C This subroutine calculates the interaction energy of nonbonded side chains
847 C assuming the LJ potential of interaction.
849 implicit real*8 (a-h,o-z)
851 parameter (accur=1.0d-10)
854 include 'COMMON.LOCAL'
855 include 'COMMON.CHAIN'
856 include 'COMMON.DERIV'
857 include 'COMMON.INTERACT'
858 include 'COMMON.TORSION'
859 include 'COMMON.SBRIDGE'
860 include 'COMMON.NAMES'
861 include 'COMMON.IOUNITS'
862 include 'COMMON.CONTACTS'
864 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
875 C Calculate SC interaction energy.
878 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
879 cd & 'iend=',iend(i,iint)
880 do j=istart(i,iint),iend(i,iint)
885 C Change 12/1/95 to calculate four-body interactions
886 rij=xj*xj+yj*yj+zj*zj
888 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
889 eps0ij=eps(itypi,itypj)
891 e1=fac*fac*aa(itypi,itypj)
892 e2=fac*bb(itypi,itypj)
894 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
895 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
896 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
897 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
898 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
899 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
902 C Calculate the components of the gradient in DC and X
904 fac=-rrij*(e1+evdwij)
909 gvdwx(k,i)=gvdwx(k,i)-gg(k)
910 gvdwx(k,j)=gvdwx(k,j)+gg(k)
911 gvdwc(k,i)=gvdwc(k,i)-gg(k)
912 gvdwc(k,j)=gvdwc(k,j)+gg(k)
916 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
920 C 12/1/95, revised on 5/20/97
922 C Calculate the contact function. The ith column of the array JCONT will
923 C contain the numbers of atoms that make contacts with the atom I (of numbers
924 C greater than I). The arrays FACONT and GACONT will contain the values of
925 C the contact function and its derivative.
927 C Uncomment next line, if the correlation interactions include EVDW explicitly.
928 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
929 C Uncomment next line, if the correlation interactions are contact function only
930 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
932 sigij=sigma(itypi,itypj)
933 r0ij=rs0(itypi,itypj)
935 C Check whether the SC's are not too far to make a contact.
938 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
939 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
941 if (fcont.gt.0.0D0) then
942 C If the SC-SC distance if close to sigma, apply spline.
943 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
944 cAdam & fcont1,fprimcont1)
945 cAdam fcont1=1.0d0-fcont1
946 cAdam if (fcont1.gt.0.0d0) then
947 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
948 cAdam fcont=fcont*fcont1
950 C Uncomment following 4 lines to have the geometric average of the epsilon0's
951 cga eps0ij=1.0d0/dsqrt(eps0ij)
953 cga gg(k)=gg(k)*eps0ij
955 cga eps0ij=-evdwij*eps0ij
956 C Uncomment for AL's type of SC correlation interactions.
958 num_conti=num_conti+1
960 facont(num_conti,i)=fcont*eps0ij
961 fprimcont=eps0ij*fprimcont/rij
963 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
964 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
965 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
966 C Uncomment following 3 lines for Skolnick's type of SC correlation.
967 gacont(1,num_conti,i)=-fprimcont*xj
968 gacont(2,num_conti,i)=-fprimcont*yj
969 gacont(3,num_conti,i)=-fprimcont*zj
970 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
971 cd write (iout,'(2i3,3f10.5)')
972 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
978 num_cont(i)=num_conti
982 gvdwc(j,i)=expon*gvdwc(j,i)
983 gvdwx(j,i)=expon*gvdwx(j,i)
986 C******************************************************************************
990 C To save time, the factor of EXPON has been extracted from ALL components
991 C of GVDWC and GRADX. Remember to multiply them by this factor before further
994 C******************************************************************************
997 C-----------------------------------------------------------------------------
998 subroutine eljk(evdw)
1000 C This subroutine calculates the interaction energy of nonbonded side chains
1001 C assuming the LJK potential of interaction.
1003 implicit real*8 (a-h,o-z)
1004 include 'DIMENSIONS'
1005 include 'COMMON.GEO'
1006 include 'COMMON.VAR'
1007 include 'COMMON.LOCAL'
1008 include 'COMMON.CHAIN'
1009 include 'COMMON.DERIV'
1010 include 'COMMON.INTERACT'
1011 include 'COMMON.IOUNITS'
1012 include 'COMMON.NAMES'
1015 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1017 do i=iatsc_s,iatsc_e
1024 C Calculate SC interaction energy.
1026 do iint=1,nint_gr(i)
1027 do j=istart(i,iint),iend(i,iint)
1032 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1033 fac_augm=rrij**expon
1034 e_augm=augm(itypi,itypj)*fac_augm
1035 r_inv_ij=dsqrt(rrij)
1037 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1038 fac=r_shift_inv**expon
1039 e1=fac*fac*aa(itypi,itypj)
1040 e2=fac*bb(itypi,itypj)
1042 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1043 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1044 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1045 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1046 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1047 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1048 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1051 C Calculate the components of the gradient in DC and X
1053 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1058 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1059 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1060 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1061 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1065 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1073 gvdwc(j,i)=expon*gvdwc(j,i)
1074 gvdwx(j,i)=expon*gvdwx(j,i)
1079 C-----------------------------------------------------------------------------
1080 subroutine ebp(evdw)
1082 C This subroutine calculates the interaction energy of nonbonded side chains
1083 C assuming the Berne-Pechukas potential of interaction.
1085 implicit real*8 (a-h,o-z)
1086 include 'DIMENSIONS'
1087 include 'COMMON.GEO'
1088 include 'COMMON.VAR'
1089 include 'COMMON.LOCAL'
1090 include 'COMMON.CHAIN'
1091 include 'COMMON.DERIV'
1092 include 'COMMON.NAMES'
1093 include 'COMMON.INTERACT'
1094 include 'COMMON.IOUNITS'
1095 include 'COMMON.CALC'
1096 common /srutu/ icall
1097 c double precision rrsave(maxdim)
1100 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1102 c if (icall.eq.0) then
1108 do i=iatsc_s,iatsc_e
1114 dxi=dc_norm(1,nres+i)
1115 dyi=dc_norm(2,nres+i)
1116 dzi=dc_norm(3,nres+i)
1117 c dsci_inv=dsc_inv(itypi)
1118 dsci_inv=vbld_inv(i+nres)
1120 C Calculate SC interaction energy.
1122 do iint=1,nint_gr(i)
1123 do j=istart(i,iint),iend(i,iint)
1126 c dscj_inv=dsc_inv(itypj)
1127 dscj_inv=vbld_inv(j+nres)
1128 chi1=chi(itypi,itypj)
1129 chi2=chi(itypj,itypi)
1136 alf12=0.5D0*(alf1+alf2)
1137 C For diagnostics only!!!
1150 dxj=dc_norm(1,nres+j)
1151 dyj=dc_norm(2,nres+j)
1152 dzj=dc_norm(3,nres+j)
1153 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1154 cd if (icall.eq.0) then
1160 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1162 C Calculate whole angle-dependent part of epsilon and contributions
1163 C to its derivatives
1164 fac=(rrij*sigsq)**expon2
1165 e1=fac*fac*aa(itypi,itypj)
1166 e2=fac*bb(itypi,itypj)
1167 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1168 eps2der=evdwij*eps3rt
1169 eps3der=evdwij*eps2rt
1170 evdwij=evdwij*eps2rt*eps3rt
1173 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1174 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1175 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1176 cd & restyp(itypi),i,restyp(itypj),j,
1177 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1178 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1179 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1182 C Calculate gradient components.
1183 e1=e1*eps1*eps2rt**2*eps3rt**2
1184 fac=-expon*(e1+evdwij)
1187 C Calculate radial part of the gradient
1191 C Calculate the angular part of the gradient and sum add the contributions
1192 C to the appropriate components of the Cartesian gradient.
1200 C-----------------------------------------------------------------------------
1201 subroutine egb(evdw)
1203 C This subroutine calculates the interaction energy of nonbonded side chains
1204 C assuming the Gay-Berne potential of interaction.
1206 implicit real*8 (a-h,o-z)
1207 include 'DIMENSIONS'
1208 include 'COMMON.GEO'
1209 include 'COMMON.VAR'
1210 include 'COMMON.LOCAL'
1211 include 'COMMON.CHAIN'
1212 include 'COMMON.DERIV'
1213 include 'COMMON.NAMES'
1214 include 'COMMON.INTERACT'
1215 include 'COMMON.IOUNITS'
1216 include 'COMMON.CALC'
1217 include 'COMMON.CONTROL'
1220 ccccc energy_dec=.false.
1221 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1224 c if (icall.eq.0) lprn=.false.
1226 do i=iatsc_s,iatsc_e
1232 dxi=dc_norm(1,nres+i)
1233 dyi=dc_norm(2,nres+i)
1234 dzi=dc_norm(3,nres+i)
1235 c dsci_inv=dsc_inv(itypi)
1236 dsci_inv=vbld_inv(i+nres)
1237 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1238 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1240 C Calculate SC interaction energy.
1242 do iint=1,nint_gr(i)
1243 do j=istart(i,iint),iend(i,iint)
1246 c dscj_inv=dsc_inv(itypj)
1247 dscj_inv=vbld_inv(j+nres)
1248 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1249 c & 1.0d0/vbld(j+nres)
1250 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1251 sig0ij=sigma(itypi,itypj)
1252 chi1=chi(itypi,itypj)
1253 chi2=chi(itypj,itypi)
1260 alf12=0.5D0*(alf1+alf2)
1261 C For diagnostics only!!!
1274 dxj=dc_norm(1,nres+j)
1275 dyj=dc_norm(2,nres+j)
1276 dzj=dc_norm(3,nres+j)
1277 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1278 c write (iout,*) "j",j," dc_norm",
1279 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1280 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1282 C Calculate angle-dependent terms of energy and contributions to their
1286 sig=sig0ij*dsqrt(sigsq)
1287 rij_shift=1.0D0/rij-sig+sig0ij
1288 c for diagnostics; uncomment
1289 c rij_shift=1.2*sig0ij
1290 C I hate to put IF's in the loops, but here don't have another choice!!!!
1291 if (rij_shift.le.0.0D0) then
1293 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1294 cd & restyp(itypi),i,restyp(itypj),j,
1295 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1299 c---------------------------------------------------------------
1300 rij_shift=1.0D0/rij_shift
1301 fac=rij_shift**expon
1302 e1=fac*fac*aa(itypi,itypj)
1303 e2=fac*bb(itypi,itypj)
1304 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1305 eps2der=evdwij*eps3rt
1306 eps3der=evdwij*eps2rt
1307 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1308 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1309 evdwij=evdwij*eps2rt*eps3rt
1312 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1313 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1314 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1315 & restyp(itypi),i,restyp(itypj),j,
1316 & epsi,sigm,chi1,chi2,chip1,chip2,
1317 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1318 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1322 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1325 C Calculate gradient components.
1326 e1=e1*eps1*eps2rt**2*eps3rt**2
1327 fac=-expon*(e1+evdwij)*rij_shift
1331 C Calculate the radial part of the gradient
1335 C Calculate angular part of the gradient.
1340 c write (iout,*) "Number of loop steps in EGB:",ind
1341 cccc energy_dec=.false.
1344 C-----------------------------------------------------------------------------
1345 subroutine egbv(evdw)
1347 C This subroutine calculates the interaction energy of nonbonded side chains
1348 C assuming the Gay-Berne-Vorobjev potential of interaction.
1350 implicit real*8 (a-h,o-z)
1351 include 'DIMENSIONS'
1352 include 'COMMON.GEO'
1353 include 'COMMON.VAR'
1354 include 'COMMON.LOCAL'
1355 include 'COMMON.CHAIN'
1356 include 'COMMON.DERIV'
1357 include 'COMMON.NAMES'
1358 include 'COMMON.INTERACT'
1359 include 'COMMON.IOUNITS'
1360 include 'COMMON.CALC'
1361 common /srutu/ icall
1364 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1367 c if (icall.eq.0) lprn=.true.
1369 do i=iatsc_s,iatsc_e
1375 dxi=dc_norm(1,nres+i)
1376 dyi=dc_norm(2,nres+i)
1377 dzi=dc_norm(3,nres+i)
1378 c dsci_inv=dsc_inv(itypi)
1379 dsci_inv=vbld_inv(i+nres)
1381 C Calculate SC interaction energy.
1383 do iint=1,nint_gr(i)
1384 do j=istart(i,iint),iend(i,iint)
1387 c dscj_inv=dsc_inv(itypj)
1388 dscj_inv=vbld_inv(j+nres)
1389 sig0ij=sigma(itypi,itypj)
1390 r0ij=r0(itypi,itypj)
1391 chi1=chi(itypi,itypj)
1392 chi2=chi(itypj,itypi)
1399 alf12=0.5D0*(alf1+alf2)
1400 C For diagnostics only!!!
1413 dxj=dc_norm(1,nres+j)
1414 dyj=dc_norm(2,nres+j)
1415 dzj=dc_norm(3,nres+j)
1416 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1418 C Calculate angle-dependent terms of energy and contributions to their
1422 sig=sig0ij*dsqrt(sigsq)
1423 rij_shift=1.0D0/rij-sig+r0ij
1424 C I hate to put IF's in the loops, but here don't have another choice!!!!
1425 if (rij_shift.le.0.0D0) then
1430 c---------------------------------------------------------------
1431 rij_shift=1.0D0/rij_shift
1432 fac=rij_shift**expon
1433 e1=fac*fac*aa(itypi,itypj)
1434 e2=fac*bb(itypi,itypj)
1435 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1436 eps2der=evdwij*eps3rt
1437 eps3der=evdwij*eps2rt
1438 fac_augm=rrij**expon
1439 e_augm=augm(itypi,itypj)*fac_augm
1440 evdwij=evdwij*eps2rt*eps3rt
1441 evdw=evdw+evdwij+e_augm
1443 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1444 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1445 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1446 & restyp(itypi),i,restyp(itypj),j,
1447 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1448 & chi1,chi2,chip1,chip2,
1449 & eps1,eps2rt**2,eps3rt**2,
1450 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1453 C Calculate gradient components.
1454 e1=e1*eps1*eps2rt**2*eps3rt**2
1455 fac=-expon*(e1+evdwij)*rij_shift
1457 fac=rij*fac-2*expon*rrij*e_augm
1458 C Calculate the radial part of the gradient
1462 C Calculate angular part of the gradient.
1468 C-----------------------------------------------------------------------------
1469 subroutine sc_angular
1470 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1471 C om12. Called by ebp, egb, and egbv.
1473 include 'COMMON.CALC'
1474 include 'COMMON.IOUNITS'
1478 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1479 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1480 om12=dxi*dxj+dyi*dyj+dzi*dzj
1482 C Calculate eps1(om12) and its derivative in om12
1483 faceps1=1.0D0-om12*chiom12
1484 faceps1_inv=1.0D0/faceps1
1485 eps1=dsqrt(faceps1_inv)
1486 C Following variable is eps1*deps1/dom12
1487 eps1_om12=faceps1_inv*chiom12
1492 c write (iout,*) "om12",om12," eps1",eps1
1493 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1498 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1499 sigsq=1.0D0-facsig*faceps1_inv
1500 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1501 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1502 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1508 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1509 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1511 C Calculate eps2 and its derivatives in om1, om2, and om12.
1514 chipom12=chip12*om12
1515 facp=1.0D0-om12*chipom12
1517 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1518 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1519 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1520 C Following variable is the square root of eps2
1521 eps2rt=1.0D0-facp1*facp_inv
1522 C Following three variables are the derivatives of the square root of eps
1523 C in om1, om2, and om12.
1524 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1525 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1526 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1527 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1528 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1529 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1530 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1531 c & " eps2rt_om12",eps2rt_om12
1532 C Calculate whole angle-dependent part of epsilon and contributions
1533 C to its derivatives
1536 C----------------------------------------------------------------------------
1538 implicit real*8 (a-h,o-z)
1539 include 'DIMENSIONS'
1540 include 'COMMON.CHAIN'
1541 include 'COMMON.DERIV'
1542 include 'COMMON.CALC'
1543 include 'COMMON.IOUNITS'
1544 double precision dcosom1(3),dcosom2(3)
1545 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1546 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1547 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1548 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1552 c eom12=evdwij*eps1_om12
1554 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1555 c & " sigder",sigder
1556 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1557 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1559 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1560 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1563 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1565 c write (iout,*) "gg",(gg(k),k=1,3)
1567 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1568 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1569 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1570 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1571 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1572 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1573 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1574 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1575 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1576 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1579 C Calculate the components of the gradient in DC and X
1583 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1587 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1588 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1592 C-----------------------------------------------------------------------
1593 subroutine e_softsphere(evdw)
1595 C This subroutine calculates the interaction energy of nonbonded side chains
1596 C assuming the LJ potential of interaction.
1598 implicit real*8 (a-h,o-z)
1599 include 'DIMENSIONS'
1600 parameter (accur=1.0d-10)
1601 include 'COMMON.GEO'
1602 include 'COMMON.VAR'
1603 include 'COMMON.LOCAL'
1604 include 'COMMON.CHAIN'
1605 include 'COMMON.DERIV'
1606 include 'COMMON.INTERACT'
1607 include 'COMMON.TORSION'
1608 include 'COMMON.SBRIDGE'
1609 include 'COMMON.NAMES'
1610 include 'COMMON.IOUNITS'
1611 include 'COMMON.CONTACTS'
1613 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1615 do i=iatsc_s,iatsc_e
1622 C Calculate SC interaction energy.
1624 do iint=1,nint_gr(i)
1625 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1626 cd & 'iend=',iend(i,iint)
1627 do j=istart(i,iint),iend(i,iint)
1632 rij=xj*xj+yj*yj+zj*zj
1633 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1634 r0ij=r0(itypi,itypj)
1636 c print *,i,j,r0ij,dsqrt(rij)
1637 if (rij.lt.r0ijsq) then
1638 evdwij=0.25d0*(rij-r0ijsq)**2
1646 C Calculate the components of the gradient in DC and X
1652 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1653 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1654 gvdwc(k,i)=gvdwc(l,k)-gg(k)
1655 gvdwc(k,j)=gvdwc(l,k)+gg(k)
1659 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1667 C--------------------------------------------------------------------------
1668 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1671 C Soft-sphere potential of p-p interaction
1673 implicit real*8 (a-h,o-z)
1674 include 'DIMENSIONS'
1675 include 'COMMON.CONTROL'
1676 include 'COMMON.IOUNITS'
1677 include 'COMMON.GEO'
1678 include 'COMMON.VAR'
1679 include 'COMMON.LOCAL'
1680 include 'COMMON.CHAIN'
1681 include 'COMMON.DERIV'
1682 include 'COMMON.INTERACT'
1683 include 'COMMON.CONTACTS'
1684 include 'COMMON.TORSION'
1685 include 'COMMON.VECTORS'
1686 include 'COMMON.FFIELD'
1688 cd write(iout,*) 'In EELEC_soft_sphere'
1695 do i=iatel_s,iatel_e
1699 xmedi=c(1,i)+0.5d0*dxi
1700 ymedi=c(2,i)+0.5d0*dyi
1701 zmedi=c(3,i)+0.5d0*dzi
1703 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1704 do j=ielstart(i),ielend(i)
1708 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1709 r0ij=rpp(iteli,itelj)
1714 xj=c(1,j)+0.5D0*dxj-xmedi
1715 yj=c(2,j)+0.5D0*dyj-ymedi
1716 zj=c(3,j)+0.5D0*dzj-zmedi
1717 rij=xj*xj+yj*yj+zj*zj
1718 if (rij.lt.r0ijsq) then
1719 evdw1ij=0.25d0*(rij-r0ijsq)**2
1727 C Calculate contributions to the Cartesian gradient.
1733 gelc(k,i)=gelc(k,i)-ggg(k)
1734 gelc(k,j)=gelc(k,j)+ggg(k)
1737 * Loop over residues i+1 thru j-1.
1741 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1748 gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1752 gelc(k,i)=gelc(k,i)+gelc(k,j)
1758 c------------------------------------------------------------------------------
1759 subroutine vec_and_deriv
1760 implicit real*8 (a-h,o-z)
1761 include 'DIMENSIONS'
1765 include 'COMMON.IOUNITS'
1766 include 'COMMON.GEO'
1767 include 'COMMON.VAR'
1768 include 'COMMON.LOCAL'
1769 include 'COMMON.CHAIN'
1770 include 'COMMON.VECTORS'
1771 include 'COMMON.SETUP'
1772 include 'COMMON.TIME1'
1773 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1774 C Compute the local reference systems. For reference system (i), the
1775 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1776 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1778 do i=ivec_start,ivec_end
1782 if (i.eq.nres-1) then
1783 C Case of the last full residue
1784 C Compute the Z-axis
1785 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1786 costh=dcos(pi-theta(nres))
1787 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1791 C Compute the derivatives of uz
1793 uzder(2,1,1)=-dc_norm(3,i-1)
1794 uzder(3,1,1)= dc_norm(2,i-1)
1795 uzder(1,2,1)= dc_norm(3,i-1)
1797 uzder(3,2,1)=-dc_norm(1,i-1)
1798 uzder(1,3,1)=-dc_norm(2,i-1)
1799 uzder(2,3,1)= dc_norm(1,i-1)
1802 uzder(2,1,2)= dc_norm(3,i)
1803 uzder(3,1,2)=-dc_norm(2,i)
1804 uzder(1,2,2)=-dc_norm(3,i)
1806 uzder(3,2,2)= dc_norm(1,i)
1807 uzder(1,3,2)= dc_norm(2,i)
1808 uzder(2,3,2)=-dc_norm(1,i)
1810 C Compute the Y-axis
1813 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1815 C Compute the derivatives of uy
1818 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1819 & -dc_norm(k,i)*dc_norm(j,i-1)
1820 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1822 uyder(j,j,1)=uyder(j,j,1)-costh
1823 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1828 uygrad(l,k,j,i)=uyder(l,k,j)
1829 uzgrad(l,k,j,i)=uzder(l,k,j)
1833 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1834 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1835 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1836 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1839 C Compute the Z-axis
1840 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1841 costh=dcos(pi-theta(i+2))
1842 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1846 C Compute the derivatives of uz
1848 uzder(2,1,1)=-dc_norm(3,i+1)
1849 uzder(3,1,1)= dc_norm(2,i+1)
1850 uzder(1,2,1)= dc_norm(3,i+1)
1852 uzder(3,2,1)=-dc_norm(1,i+1)
1853 uzder(1,3,1)=-dc_norm(2,i+1)
1854 uzder(2,3,1)= dc_norm(1,i+1)
1857 uzder(2,1,2)= dc_norm(3,i)
1858 uzder(3,1,2)=-dc_norm(2,i)
1859 uzder(1,2,2)=-dc_norm(3,i)
1861 uzder(3,2,2)= dc_norm(1,i)
1862 uzder(1,3,2)= dc_norm(2,i)
1863 uzder(2,3,2)=-dc_norm(1,i)
1865 C Compute the Y-axis
1868 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1870 C Compute the derivatives of uy
1873 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1874 & -dc_norm(k,i)*dc_norm(j,i+1)
1875 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1877 uyder(j,j,1)=uyder(j,j,1)-costh
1878 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1883 uygrad(l,k,j,i)=uyder(l,k,j)
1884 uzgrad(l,k,j,i)=uzder(l,k,j)
1888 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1889 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1890 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1891 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1895 vbld_inv_temp(1)=vbld_inv(i+1)
1896 if (i.lt.nres-1) then
1897 vbld_inv_temp(2)=vbld_inv(i+2)
1899 vbld_inv_temp(2)=vbld_inv(i)
1904 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1905 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1910 #if defined(PARVEC) && defined(MPI)
1911 if (nfgtasks.gt.1) then
1913 c print *,"Processor",fg_rank,kolor," ivec_start",ivec_start,
1914 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
1915 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
1916 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank),
1917 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
1919 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank),
1920 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
1922 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
1923 & ivec_count(fg_rank),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
1924 & ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR)
1925 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
1926 & ivec_count(fg_rank),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
1927 & ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR)
1928 time_gather=time_gather+MPI_Wtime()-time00
1930 c if (fg_rank.eq.0) then
1931 c write (iout,*) "Arrays UY and UZ"
1933 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
1940 C-----------------------------------------------------------------------------
1941 subroutine check_vecgrad
1942 implicit real*8 (a-h,o-z)
1943 include 'DIMENSIONS'
1944 include 'COMMON.IOUNITS'
1945 include 'COMMON.GEO'
1946 include 'COMMON.VAR'
1947 include 'COMMON.LOCAL'
1948 include 'COMMON.CHAIN'
1949 include 'COMMON.VECTORS'
1950 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1951 dimension uyt(3,maxres),uzt(3,maxres)
1952 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1953 double precision delta /1.0d-7/
1956 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1957 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1958 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1959 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1960 cd & (dc_norm(if90,i),if90=1,3)
1961 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1962 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1963 cd write(iout,'(a)')
1969 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1970 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1983 cd write (iout,*) 'i=',i
1985 erij(k)=dc_norm(k,i)
1989 dc_norm(k,i)=erij(k)
1991 dc_norm(j,i)=dc_norm(j,i)+delta
1992 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1994 c dc_norm(k,i)=dc_norm(k,i)/fac
1996 c write (iout,*) (dc_norm(k,i),k=1,3)
1997 c write (iout,*) (erij(k),k=1,3)
2000 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2001 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2002 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2003 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2005 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2006 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2007 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2010 dc_norm(k,i)=erij(k)
2013 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2014 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2015 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2016 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2017 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2018 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2019 cd write (iout,'(a)')
2024 C--------------------------------------------------------------------------
2025 subroutine set_matrices
2026 implicit real*8 (a-h,o-z)
2027 include 'DIMENSIONS'
2030 include "COMMON.SETUP"
2032 integer status(MPI_STATUS_SIZE)
2034 include 'COMMON.IOUNITS'
2035 include 'COMMON.GEO'
2036 include 'COMMON.VAR'
2037 include 'COMMON.LOCAL'
2038 include 'COMMON.CHAIN'
2039 include 'COMMON.DERIV'
2040 include 'COMMON.INTERACT'
2041 include 'COMMON.CONTACTS'
2042 include 'COMMON.TORSION'
2043 include 'COMMON.VECTORS'
2044 include 'COMMON.FFIELD'
2045 double precision auxvec(2),auxmat(2,2)
2047 C Compute the virtual-bond-torsional-angle dependent quantities needed
2048 C to calculate the el-loc multibody terms of various order.
2051 do i=ivec_start+2,ivec_end+2
2055 if (i .lt. nres+1) then
2092 if (i .gt. 3 .and. i .lt. nres+1) then
2093 obrot_der(1,i-2)=-sin1
2094 obrot_der(2,i-2)= cos1
2095 Ugder(1,1,i-2)= sin1
2096 Ugder(1,2,i-2)=-cos1
2097 Ugder(2,1,i-2)=-cos1
2098 Ugder(2,2,i-2)=-sin1
2101 obrot2_der(1,i-2)=-dwasin2
2102 obrot2_der(2,i-2)= dwacos2
2103 Ug2der(1,1,i-2)= dwasin2
2104 Ug2der(1,2,i-2)=-dwacos2
2105 Ug2der(2,1,i-2)=-dwacos2
2106 Ug2der(2,2,i-2)=-dwasin2
2108 obrot_der(1,i-2)=0.0d0
2109 obrot_der(2,i-2)=0.0d0
2110 Ugder(1,1,i-2)=0.0d0
2111 Ugder(1,2,i-2)=0.0d0
2112 Ugder(2,1,i-2)=0.0d0
2113 Ugder(2,2,i-2)=0.0d0
2114 obrot2_der(1,i-2)=0.0d0
2115 obrot2_der(2,i-2)=0.0d0
2116 Ug2der(1,1,i-2)=0.0d0
2117 Ug2der(1,2,i-2)=0.0d0
2118 Ug2der(2,1,i-2)=0.0d0
2119 Ug2der(2,2,i-2)=0.0d0
2121 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2122 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2123 iti = itortyp(itype(i-2))
2127 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2128 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2129 iti1 = itortyp(itype(i-1))
2133 cd write (iout,*) '*******i',i,' iti1',iti
2134 cd write (iout,*) 'b1',b1(:,iti)
2135 cd write (iout,*) 'b2',b2(:,iti)
2136 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2137 c if (i .gt. iatel_s+2) then
2138 if (i .gt. nnt+2) then
2139 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2140 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2141 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2143 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2144 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2145 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2146 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2147 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2158 DtUg2(l,k,i-2)=0.0d0
2162 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2163 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2165 muder(k,i-2)=Ub2der(k,i-2)
2167 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2168 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2169 iti1 = itortyp(itype(i-1))
2174 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2176 cd write (iout,*) 'mu ',mu(:,i-2)
2177 cd write (iout,*) 'mu1',mu1(:,i-2)
2178 cd write (iout,*) 'mu2',mu2(:,i-2)
2179 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2181 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2182 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2183 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2184 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2185 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2186 C Vectors and matrices dependent on a single virtual-bond dihedral.
2187 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2188 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2189 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2190 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2191 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2192 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2193 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2194 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2195 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2198 C Matrices dependent on two consecutive virtual-bond dihedrals.
2199 C The order of matrices is from left to right.
2200 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2202 do i=ivec_start,ivec_end
2204 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2205 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2206 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2207 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2208 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2209 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2210 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2211 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2214 #if defined(MPI) && defined(PARMAT)
2216 c if (fg_rank.eq.0) then
2217 write (iout,*) "Arrays UG and UGDER before GATHER"
2219 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2220 & ((ug(l,k,i),l=1,2),k=1,2),
2221 & ((ugder(l,k,i),l=1,2),k=1,2)
2223 write (iout,*) "Arrays UG2 and UG2DER"
2225 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2226 & ((ug2(l,k,i),l=1,2),k=1,2),
2227 & ((ug2der(l,k,i),l=1,2),k=1,2)
2229 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2231 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2232 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2233 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2235 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2237 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2238 & costab(i),sintab(i),costab2(i),sintab2(i)
2240 write (iout,*) "Array MUDER"
2242 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2246 if (nfgtasks.gt.1) then
2248 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2249 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2250 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2252 c write (iout,*) "MPI_ROTAT",MPI_ROTAT
2253 c call MPI_Allgatherv(ug(1,1,ivec_start),ivec_count(fg_rank),
2254 c & MPI_MAT1,ug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2256 c call MPI_Allgatherv(ugder(1,1,ivec_start),ivec_count(fg_rank),
2257 c & MPI_MAT1,ugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2259 c call MPI_Allgatherv(ug2(1,1,ivec_start),ivec_count(fg_rank),
2260 c & MPI_MAT1,ug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2262 c call MPI_Allgatherv(ug2der(1,1,ivec_start),ivec_count(fg_rank),
2263 c & MPI_MAT1,ug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2265 c call MPI_Allgatherv(obrot(1,ivec_start),ivec_count(fg_rank),
2266 c & MPI_MU,obrot(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2268 c call MPI_Allgatherv(obrot2(1,ivec_start),ivec_count(fg_rank),
2269 c & MPI_MU,obrot2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2271 c call MPI_Allgatherv(obrot_der(1,ivec_start),ivec_count(fg_rank),
2272 c & MPI_MU,obrot_der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2274 c call MPI_Allgatherv(obrot2_der(1,ivec_start),
2275 c & ivec_count(fg_rank),
2276 c & MPI_MU,obrot2_der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2278 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank),
2279 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2281 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank),
2282 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2284 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank),
2285 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2287 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank),
2288 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2290 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank),
2291 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2293 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank),
2294 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2296 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank),
2297 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2298 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2299 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank),
2300 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2301 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2302 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank),
2303 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2304 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2305 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank),
2306 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2307 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
2308 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2310 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank),
2311 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2313 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank),
2314 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2316 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank),
2317 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2319 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank),
2320 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2322 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank),
2323 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2325 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2326 & ivec_count(fg_rank),
2327 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2329 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank),
2330 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2332 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank),
2333 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2335 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank),
2336 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2338 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank),
2339 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2341 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank),
2342 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2344 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank),
2345 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2347 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank),
2348 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2350 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2351 & ivec_count(fg_rank),
2352 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2354 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank),
2355 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2357 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank),
2358 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2360 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank),
2361 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2363 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank),
2364 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2366 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2367 & ivec_count(fg_rank),
2368 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2370 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2371 & ivec_count(fg_rank),
2372 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2374 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2375 & ivec_count(fg_rank),
2376 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2377 & MPI_MAT2,FG_COMM,IERR)
2378 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2379 & ivec_count(fg_rank),
2380 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2381 & MPI_MAT2,FG_COMM,IERR)
2384 c Passes matrix info through the ring
2387 if (irecv.lt.0) irecv=nfgtasks-1
2390 if (inext.ge.nfgtasks) inext=0
2392 c write (iout,*) "isend",isend," irecv",irecv
2394 lensend=lentyp(isend)
2395 lenrecv=lentyp(irecv)
2396 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2397 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2398 c & MPI_ROTAT1(lensend),inext,2200+isend,
2399 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2400 c & iprev,2200+irecv,FG_COMM,status,IERR)
2401 c write (iout,*) "Gather ROTAT1"
2403 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2404 c & MPI_ROTAT2(lensend),inext,3300+isend,
2405 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2406 c & iprev,3300+irecv,FG_COMM,status,IERR)
2407 c write (iout,*) "Gather ROTAT2"
2409 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2410 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2411 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2412 & iprev,4400+irecv,FG_COMM,status,IERR)
2413 c write (iout,*) "Gather ROTAT_OLD"
2415 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2416 & MPI_PRECOMP11(lensend),inext,5500+isend,
2417 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2418 & iprev,5500+irecv,FG_COMM,status,IERR)
2419 c write (iout,*) "Gather PRECOMP11"
2421 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2422 & MPI_PRECOMP12(lensend),inext,6600+isend,
2423 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2424 & iprev,6600+irecv,FG_COMM,status,IERR)
2425 c write (iout,*) "Gather PRECOMP12"
2427 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2429 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2430 & MPI_ROTAT2(lensend),inext,7700+isend,
2431 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2432 & iprev,7700+irecv,FG_COMM,status,IERR)
2433 c write (iout,*) "Gather PRECOMP21"
2435 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2436 & MPI_PRECOMP22(lensend),inext,8800+isend,
2437 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2438 & iprev,8800+irecv,FG_COMM,status,IERR)
2439 c write (iout,*) "Gather PRECOMP22"
2441 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2442 & MPI_PRECOMP23(lensend),inext,9900+isend,
2443 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2444 & MPI_PRECOMP23(lenrecv),
2445 & iprev,9900+irecv,FG_COMM,status,IERR)
2446 c write (iout,*) "Gather PRECOMP23"
2451 if (irecv.lt.0) irecv=nfgtasks-1
2454 time_gather=time_gather+MPI_Wtime()-time00
2457 c if (fg_rank.eq.0) then
2458 write (iout,*) "Arrays UG and UGDER"
2460 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2461 & ((ug(l,k,i),l=1,2),k=1,2),
2462 & ((ugder(l,k,i),l=1,2),k=1,2)
2464 write (iout,*) "Arrays UG2 and UG2DER"
2466 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2467 & ((ug2(l,k,i),l=1,2),k=1,2),
2468 & ((ug2der(l,k,i),l=1,2),k=1,2)
2470 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2472 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2473 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2474 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2476 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2478 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2479 & costab(i),sintab(i),costab2(i),sintab2(i)
2481 write (iout,*) "Array MUDER"
2483 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2489 cd iti = itortyp(itype(i))
2492 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2493 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2498 C--------------------------------------------------------------------------
2499 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2501 C This subroutine calculates the average interaction energy and its gradient
2502 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2503 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2504 C The potential depends both on the distance of peptide-group centers and on
2505 C the orientation of the CA-CA virtual bonds.
2507 implicit real*8 (a-h,o-z)
2508 include 'DIMENSIONS'
2509 include 'COMMON.CONTROL'
2510 include 'COMMON.SETUP'
2511 include 'COMMON.IOUNITS'
2512 include 'COMMON.GEO'
2513 include 'COMMON.VAR'
2514 include 'COMMON.LOCAL'
2515 include 'COMMON.CHAIN'
2516 include 'COMMON.DERIV'
2517 include 'COMMON.INTERACT'
2518 include 'COMMON.CONTACTS'
2519 include 'COMMON.TORSION'
2520 include 'COMMON.VECTORS'
2521 include 'COMMON.FFIELD'
2522 include 'COMMON.TIME1'
2523 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2524 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2525 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2526 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2527 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2528 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2530 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2532 double precision scal_el /1.0d0/
2534 double precision scal_el /0.5d0/
2537 C 13-go grudnia roku pamietnego...
2538 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2539 & 0.0d0,1.0d0,0.0d0,
2540 & 0.0d0,0.0d0,1.0d0/
2541 cd write(iout,*) 'In EELEC'
2543 cd write(iout,*) 'Type',i
2544 cd write(iout,*) 'B1',B1(:,i)
2545 cd write(iout,*) 'B2',B2(:,i)
2546 cd write(iout,*) 'CC',CC(:,:,i)
2547 cd write(iout,*) 'DD',DD(:,:,i)
2548 cd write(iout,*) 'EE',EE(:,:,i)
2550 cd call check_vecgrad
2552 if (icheckgrad.eq.1) then
2554 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2556 dc_norm(k,i)=dc(k,i)*fac
2558 c write (iout,*) 'i',i,' fac',fac
2561 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2562 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2563 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2564 c call vec_and_deriv
2568 cd write (iout,*) 'i=',i
2570 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2573 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2574 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2587 cd print '(a)','Enter EELEC'
2588 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2590 gel_loc_loc(i)=0.0d0
2595 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2597 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2601 do i=iturn3_start,iturn3_end
2605 dx_normi=dc_norm(1,i)
2606 dy_normi=dc_norm(2,i)
2607 dz_normi=dc_norm(3,i)
2608 xmedi=c(1,i)+0.5d0*dxi
2609 ymedi=c(2,i)+0.5d0*dyi
2610 zmedi=c(3,i)+0.5d0*dzi
2612 call eelecij(i,i+2,ees,evdw1,eel_loc)
2613 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2614 num_cont_hb(i)=num_conti
2618 do i=iturn4_start,iturn4_end
2622 dx_normi=dc_norm(1,i)
2623 dy_normi=dc_norm(2,i)
2624 dz_normi=dc_norm(3,i)
2625 xmedi=c(1,i)+0.5d0*dxi
2626 ymedi=c(2,i)+0.5d0*dyi
2627 zmedi=c(3,i)+0.5d0*dzi
2629 call eelecij(i,i+3,ees,evdw1,eel_loc)
2630 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
2631 num_cont_hb(i)=num_cont_hb(i)+num_conti
2635 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2637 do i=iatel_s,iatel_e
2641 dx_normi=dc_norm(1,i)
2642 dy_normi=dc_norm(2,i)
2643 dz_normi=dc_norm(3,i)
2644 xmedi=c(1,i)+0.5d0*dxi
2645 ymedi=c(2,i)+0.5d0*dyi
2646 zmedi=c(3,i)+0.5d0*dzi
2648 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2649 do j=ielstart(i),ielend(i)
2650 call eelecij(i,j,ees,evdw1,eel_loc)
2652 num_cont_hb(i)=num_cont_hb(i)+num_conti
2654 c write (iout,*) "Number of loop steps in EELEC:",ind
2656 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2657 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2659 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2660 ccc eel_loc=eel_loc+eello_turn3
2661 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2664 C-------------------------------------------------------------------------------
2665 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2666 implicit real*8 (a-h,o-z)
2667 include 'DIMENSIONS'
2671 include 'COMMON.CONTROL'
2672 include 'COMMON.IOUNITS'
2673 include 'COMMON.GEO'
2674 include 'COMMON.VAR'
2675 include 'COMMON.LOCAL'
2676 include 'COMMON.CHAIN'
2677 include 'COMMON.DERIV'
2678 include 'COMMON.INTERACT'
2679 include 'COMMON.CONTACTS'
2680 include 'COMMON.TORSION'
2681 include 'COMMON.VECTORS'
2682 include 'COMMON.FFIELD'
2683 include 'COMMON.TIME1'
2684 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2685 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2686 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2687 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2688 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2689 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2691 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2693 double precision scal_el /1.0d0/
2695 double precision scal_el /0.5d0/
2698 C 13-go grudnia roku pamietnego...
2699 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2700 & 0.0d0,1.0d0,0.0d0,
2701 & 0.0d0,0.0d0,1.0d0/
2702 c time00=MPI_Wtime()
2703 cd write (iout,*) "eelecij",i,j
2707 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2708 aaa=app(iteli,itelj)
2709 bbb=bpp(iteli,itelj)
2710 ael6i=ael6(iteli,itelj)
2711 ael3i=ael3(iteli,itelj)
2715 dx_normj=dc_norm(1,j)
2716 dy_normj=dc_norm(2,j)
2717 dz_normj=dc_norm(3,j)
2718 xj=c(1,j)+0.5D0*dxj-xmedi
2719 yj=c(2,j)+0.5D0*dyj-ymedi
2720 zj=c(3,j)+0.5D0*dzj-zmedi
2721 rij=xj*xj+yj*yj+zj*zj
2727 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2728 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2729 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2730 fac=cosa-3.0D0*cosb*cosg
2732 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2733 if (j.eq.i+2) ev1=scal_el*ev1
2738 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2741 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2742 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2745 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2746 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2747 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2748 cd & xmedi,ymedi,zmedi,xj,yj,zj
2750 if (energy_dec) then
2751 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2752 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2756 C Calculate contributions to the Cartesian gradient.
2759 facvdw=-6*rrmij*(ev1+evdwij)
2760 facel=-3*rrmij*(el1+eesij)
2766 * Radial derivatives. First process both termini of the fragment (i,j)
2772 c ghalf=0.5D0*ggg(k)
2773 c gelc(k,i)=gelc(k,i)+ghalf
2774 c gelc(k,j)=gelc(k,j)+ghalf
2776 c 9/28/08 AL Gradient compotents will be summed only at the end
2778 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2779 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2782 * Loop over residues i+1 thru j-1.
2786 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2793 c ghalf=0.5D0*ggg(k)
2794 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2795 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2797 c 9/28/08 AL Gradient compotents will be summed only at the end
2799 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2800 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2803 * Loop over residues i+1 thru j-1.
2807 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2814 fac=-3*rrmij*(facvdw+facvdw+facel)
2819 * Radial derivatives. First process both termini of the fragment (i,j)
2825 c ghalf=0.5D0*ggg(k)
2826 c gelc(k,i)=gelc(k,i)+ghalf
2827 c gelc(k,j)=gelc(k,j)+ghalf
2829 c 9/28/08 AL Gradient compotents will be summed only at the end
2831 gelc_long(k,j)=gelc(k,j)+ggg(k)
2832 gelc_long(k,i)=gelc(k,i)-ggg(k)
2835 * Loop over residues i+1 thru j-1.
2839 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2842 c 9/28/08 AL Gradient compotents will be summed only at the end
2847 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2848 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2854 ecosa=2.0D0*fac3*fac1+fac4
2857 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2858 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2860 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2861 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2863 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2864 cd & (dcosg(k),k=1,3)
2866 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2869 c ghalf=0.5D0*ggg(k)
2870 c gelc(k,i)=gelc(k,i)+ghalf
2871 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2872 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2873 c gelc(k,j)=gelc(k,j)+ghalf
2874 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2875 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2879 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2884 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2885 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2887 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2888 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2889 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2890 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2892 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2893 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2894 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2896 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2897 C energy of a peptide unit is assumed in the form of a second-order
2898 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2899 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2900 C are computed for EVERY pair of non-contiguous peptide groups.
2902 if (j.lt.nres-1) then
2913 muij(kkk)=mu(k,i)*mu(l,j)
2916 cd write (iout,*) 'EELEC: i',i,' j',j
2917 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2918 cd write(iout,*) 'muij',muij
2919 ury=scalar(uy(1,i),erij)
2920 urz=scalar(uz(1,i),erij)
2921 vry=scalar(uy(1,j),erij)
2922 vrz=scalar(uz(1,j),erij)
2923 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2924 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2925 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2926 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2927 fac=dsqrt(-ael6i)*r3ij
2932 cd write (iout,'(4i5,4f10.5)')
2933 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2934 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2935 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2936 cd & uy(:,j),uz(:,j)
2937 cd write (iout,'(4f10.5)')
2938 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2939 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2940 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2941 cd write (iout,'(9f10.5/)')
2942 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2943 C Derivatives of the elements of A in virtual-bond vectors
2944 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2946 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2947 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2948 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2949 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2950 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2951 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2952 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2953 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2954 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2955 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2956 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2957 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2959 C Compute radial contributions to the gradient
2977 C Add the contributions coming from er
2980 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2981 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2982 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2983 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2986 C Derivatives in DC(i)
2987 ghalf1=0.5d0*agg(k,1)
2988 ghalf2=0.5d0*agg(k,2)
2989 ghalf3=0.5d0*agg(k,3)
2990 ghalf4=0.5d0*agg(k,4)
2991 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2992 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2993 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2994 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2995 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2996 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2997 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2998 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2999 C Derivatives in DC(i+1)
3000 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3001 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3002 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3003 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3004 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3005 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3006 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3007 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3008 C Derivatives in DC(j)
3009 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3010 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3011 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3012 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3013 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3014 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3015 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3016 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3017 C Derivatives in DC(j+1) or DC(nres-1)
3018 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3019 & -3.0d0*vryg(k,3)*ury)
3020 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3021 & -3.0d0*vrzg(k,3)*ury)
3022 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3023 & -3.0d0*vryg(k,3)*urz)
3024 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3025 & -3.0d0*vrzg(k,3)*urz)
3026 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3028 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3041 aggi(k,l)=-aggi(k,l)
3042 aggi1(k,l)=-aggi1(k,l)
3043 aggj(k,l)=-aggj(k,l)
3044 aggj1(k,l)=-aggj1(k,l)
3047 if (j.lt.nres-1) then
3053 aggi(k,l)=-aggi(k,l)
3054 aggi1(k,l)=-aggi1(k,l)
3055 aggj(k,l)=-aggj(k,l)
3056 aggj1(k,l)=-aggj1(k,l)
3067 aggi(k,l)=-aggi(k,l)
3068 aggi1(k,l)=-aggi1(k,l)
3069 aggj(k,l)=-aggj(k,l)
3070 aggj1(k,l)=-aggj1(k,l)
3075 IF (wel_loc.gt.0.0d0) THEN
3076 C Contribution to the local-electrostatic energy coming from the i-j pair
3077 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3079 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3081 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3082 & 'eelloc',i,j,eel_loc_ij
3084 eel_loc=eel_loc+eel_loc_ij
3085 C Partial derivatives in virtual-bond dihedral angles gamma
3087 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3088 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3089 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3090 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3091 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3092 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3093 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3095 ggg(l)=agg(l,1)*muij(1)+
3096 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3097 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3098 if (j.lt.nres-1 .or. j.eq.nres-1.and.j-i.eq.2)
3099 & gel_loc_long_j2(l,j)=gel_loc_long_j2(l,j)+ggg(l)
3100 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3101 cgrad ghalf=0.5d0*ggg(l)
3102 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3103 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3107 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3110 C Remaining derivatives of eello
3112 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3113 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3114 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3115 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3116 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3117 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3118 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3119 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3122 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3125 ghalf=0.5d0*agg(l,k)
3126 aggi(l,k)=aggi(l,k)+ghalf
3127 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3128 aggj(l,k)=aggj(l,k)+ghalf
3131 if (j.eq.nres-1 .and. i.lt.j-2) then
3134 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3139 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3140 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3141 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3142 & .and. num_conti.le.maxconts) then
3143 c write (iout,*) i,j," entered corr"
3145 C Calculate the contact function. The ith column of the array JCONT will
3146 C contain the numbers of atoms that make contacts with the atom I (of numbers
3147 C greater than I). The arrays FACONT and GACONT will contain the values of
3148 C the contact function and its derivative.
3149 c r0ij=1.02D0*rpp(iteli,itelj)
3150 c r0ij=1.11D0*rpp(iteli,itelj)
3151 r0ij=2.20D0*rpp(iteli,itelj)
3152 c r0ij=1.55D0*rpp(iteli,itelj)
3153 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3154 if (fcont.gt.0.0D0) then
3155 num_conti=num_conti+1
3156 if (num_conti.gt.maxconts) then
3157 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3158 & ' will skip next contacts for this conf.'
3160 jcont_hb(num_conti,i)=j
3161 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3162 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3163 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3165 d_cont(num_conti,i)=rij
3166 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3167 C --- Electrostatic-interaction matrix ---
3168 a_chuj(1,1,num_conti,i)=a22
3169 a_chuj(1,2,num_conti,i)=a23
3170 a_chuj(2,1,num_conti,i)=a32
3171 a_chuj(2,2,num_conti,i)=a33
3172 C --- Gradient of rij
3174 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3181 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3182 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3183 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3184 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3185 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3190 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3191 C Calculate contact energies
3193 wij=cosa-3.0D0*cosb*cosg
3196 c fac3=dsqrt(-ael6i)/r0ij**3
3197 fac3=dsqrt(-ael6i)*r3ij
3198 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3199 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3200 if (ees0tmp.gt.0) then
3201 ees0pij=dsqrt(ees0tmp)
3205 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3206 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3207 if (ees0tmp.gt.0) then
3208 ees0mij=dsqrt(ees0tmp)
3213 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3214 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3215 C Diagnostics. Comment out or remove after debugging!
3216 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3217 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3218 c ees0m(num_conti,i)=0.0D0
3220 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3221 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3222 C Angular derivatives of the contact function
3223 ees0pij1=fac3/ees0pij
3224 ees0mij1=fac3/ees0mij
3225 fac3p=-3.0D0*fac3*rrmij
3226 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3227 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3229 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3230 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3231 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3232 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3233 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3234 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3235 ecosap=ecosa1+ecosa2
3236 ecosbp=ecosb1+ecosb2
3237 ecosgp=ecosg1+ecosg2
3238 ecosam=ecosa1-ecosa2
3239 ecosbm=ecosb1-ecosb2
3240 ecosgm=ecosg1-ecosg2
3249 facont_hb(num_conti,i)=fcont
3250 fprimcont=fprimcont/rij
3251 cd facont_hb(num_conti,i)=1.0D0
3252 C Following line is for diagnostics.
3255 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3256 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3259 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3260 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3262 gggp(1)=gggp(1)+ees0pijp*xj
3263 gggp(2)=gggp(2)+ees0pijp*yj
3264 gggp(3)=gggp(3)+ees0pijp*zj
3265 gggm(1)=gggm(1)+ees0mijp*xj
3266 gggm(2)=gggm(2)+ees0mijp*yj
3267 gggm(3)=gggm(3)+ees0mijp*zj
3268 C Derivatives due to the contact function
3269 gacont_hbr(1,num_conti,i)=fprimcont*xj
3270 gacont_hbr(2,num_conti,i)=fprimcont*yj
3271 gacont_hbr(3,num_conti,i)=fprimcont*zj
3273 ghalfp=0.5D0*gggp(k)
3274 ghalfm=0.5D0*gggm(k)
3275 gacontp_hb1(k,num_conti,i)=ghalfp
3276 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3277 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3278 gacontp_hb2(k,num_conti,i)=ghalfp
3279 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3280 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3281 gacontp_hb3(k,num_conti,i)=gggp(k)
3282 gacontm_hb1(k,num_conti,i)=ghalfm
3283 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3284 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3285 gacontm_hb2(k,num_conti,i)=ghalfm
3286 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3287 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3288 gacontm_hb3(k,num_conti,i)=gggm(k)
3290 C Diagnostics. Comment out or remove after debugging!
3292 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3293 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3294 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3295 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3296 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3297 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3300 endif ! num_conti.le.maxconts
3303 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3306 C-----------------------------------------------------------------------------
3307 subroutine eturn3(i,eello_turn3)
3308 C Third- and fourth-order contributions from turns
3309 implicit real*8 (a-h,o-z)
3310 include 'DIMENSIONS'
3311 include 'COMMON.IOUNITS'
3312 include 'COMMON.GEO'
3313 include 'COMMON.VAR'
3314 include 'COMMON.LOCAL'
3315 include 'COMMON.CHAIN'
3316 include 'COMMON.DERIV'
3317 include 'COMMON.INTERACT'
3318 include 'COMMON.CONTACTS'
3319 include 'COMMON.TORSION'
3320 include 'COMMON.VECTORS'
3321 include 'COMMON.FFIELD'
3322 include 'COMMON.CONTROL'
3324 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3325 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3326 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3327 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3328 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3329 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3330 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3333 c write (iout,*) "eturn3",i,j,j1,j2
3338 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3340 C Third-order contributions
3347 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3348 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3349 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3350 call transpose2(auxmat(1,1),auxmat1(1,1))
3351 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3352 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3353 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3354 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3355 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3356 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3357 cd & ' eello_turn3_num',4*eello_turn3_num
3358 C Derivatives in gamma(i)
3359 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3360 call transpose2(auxmat2(1,1),auxmat3(1,1))
3361 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3362 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3363 C Derivatives in gamma(i+1)
3364 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3365 call transpose2(auxmat2(1,1),auxmat3(1,1))
3366 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3367 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3368 & +0.5d0*(pizda(1,1)+pizda(2,2))
3369 C Cartesian derivatives
3371 c ghalf1=0.5d0*agg(l,1)
3372 c ghalf2=0.5d0*agg(l,2)
3373 c ghalf3=0.5d0*agg(l,3)
3374 c ghalf4=0.5d0*agg(l,4)
3375 a_temp(1,1)=aggi(l,1)!+ghalf1
3376 a_temp(1,2)=aggi(l,2)!+ghalf2
3377 a_temp(2,1)=aggi(l,3)!+ghalf3
3378 a_temp(2,2)=aggi(l,4)!+ghalf4
3379 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3380 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3381 & +0.5d0*(pizda(1,1)+pizda(2,2))
3382 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3383 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3384 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3385 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3386 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3387 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3388 & +0.5d0*(pizda(1,1)+pizda(2,2))
3389 a_temp(1,1)=aggj(l,1)!+ghalf1
3390 a_temp(1,2)=aggj(l,2)!+ghalf2
3391 a_temp(2,1)=aggj(l,3)!+ghalf3
3392 a_temp(2,2)=aggj(l,4)!+ghalf4
3393 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3394 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3395 & +0.5d0*(pizda(1,1)+pizda(2,2))
3396 a_temp(1,1)=aggj1(l,1)
3397 a_temp(1,2)=aggj1(l,2)
3398 a_temp(2,1)=aggj1(l,3)
3399 a_temp(2,2)=aggj1(l,4)
3400 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3401 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3402 & +0.5d0*(pizda(1,1)+pizda(2,2))
3406 C-------------------------------------------------------------------------------
3407 subroutine eturn4(i,eello_turn4)
3408 C Third- and fourth-order contributions from turns
3409 implicit real*8 (a-h,o-z)
3410 include 'DIMENSIONS'
3411 include 'COMMON.IOUNITS'
3412 include 'COMMON.GEO'
3413 include 'COMMON.VAR'
3414 include 'COMMON.LOCAL'
3415 include 'COMMON.CHAIN'
3416 include 'COMMON.DERIV'
3417 include 'COMMON.INTERACT'
3418 include 'COMMON.CONTACTS'
3419 include 'COMMON.TORSION'
3420 include 'COMMON.VECTORS'
3421 include 'COMMON.FFIELD'
3422 include 'COMMON.CONTROL'
3424 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3425 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3426 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3427 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3428 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3429 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3430 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3433 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3435 C Fourth-order contributions
3443 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3444 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3445 write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3450 iti1=itortyp(itype(i+1))
3451 iti2=itortyp(itype(i+2))
3452 iti3=itortyp(itype(i+3))
3453 write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3454 call transpose2(EUg(1,1,i+1),e1t(1,1))
3455 call transpose2(Eug(1,1,i+2),e2t(1,1))
3456 call transpose2(Eug(1,1,i+3),e3t(1,1))
3457 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3458 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3459 s1=scalar2(b1(1,iti2),auxvec(1))
3460 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3461 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3462 s2=scalar2(b1(1,iti1),auxvec(1))
3463 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3464 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3465 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3466 eello_turn4=eello_turn4-(s1+s2+s3)
3467 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3468 & 'eturn4',i,j,-(s1+s2+s3)
3469 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3470 cd & ' eello_turn4_num',8*eello_turn4_num
3471 C Derivatives in gamma(i)
3472 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3473 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3474 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3475 s1=scalar2(b1(1,iti2),auxvec(1))
3476 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3477 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3478 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3479 C Derivatives in gamma(i+1)
3480 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3481 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3482 s2=scalar2(b1(1,iti1),auxvec(1))
3483 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3484 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3485 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3486 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3487 C Derivatives in gamma(i+2)
3488 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3489 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3490 s1=scalar2(b1(1,iti2),auxvec(1))
3491 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3492 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3493 s2=scalar2(b1(1,iti1),auxvec(1))
3494 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3495 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3496 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3497 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3498 C Cartesian derivatives
3499 C Derivatives of this turn contributions in DC(i+2)
3500 if (j.lt.nres-1) then
3502 a_temp(1,1)=agg(l,1)
3503 a_temp(1,2)=agg(l,2)
3504 a_temp(2,1)=agg(l,3)
3505 a_temp(2,2)=agg(l,4)
3506 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3507 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3508 s1=scalar2(b1(1,iti2),auxvec(1))
3509 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3510 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3511 s2=scalar2(b1(1,iti1),auxvec(1))
3512 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3513 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3514 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3516 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3519 C Remaining derivatives of this turn contribution
3521 a_temp(1,1)=aggi(l,1)
3522 a_temp(1,2)=aggi(l,2)
3523 a_temp(2,1)=aggi(l,3)
3524 a_temp(2,2)=aggi(l,4)
3525 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3526 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3527 s1=scalar2(b1(1,iti2),auxvec(1))
3528 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3529 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3530 s2=scalar2(b1(1,iti1),auxvec(1))
3531 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3532 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3533 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3534 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3535 a_temp(1,1)=aggi1(l,1)
3536 a_temp(1,2)=aggi1(l,2)
3537 a_temp(2,1)=aggi1(l,3)
3538 a_temp(2,2)=aggi1(l,4)
3539 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3540 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3541 s1=scalar2(b1(1,iti2),auxvec(1))
3542 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3543 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3544 s2=scalar2(b1(1,iti1),auxvec(1))
3545 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3546 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3547 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3548 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3549 a_temp(1,1)=aggj(l,1)
3550 a_temp(1,2)=aggj(l,2)
3551 a_temp(2,1)=aggj(l,3)
3552 a_temp(2,2)=aggj(l,4)
3553 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3554 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3555 s1=scalar2(b1(1,iti2),auxvec(1))
3556 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3557 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3558 s2=scalar2(b1(1,iti1),auxvec(1))
3559 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3560 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3561 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3562 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3563 a_temp(1,1)=aggj1(l,1)
3564 a_temp(1,2)=aggj1(l,2)
3565 a_temp(2,1)=aggj1(l,3)
3566 a_temp(2,2)=aggj1(l,4)
3567 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3568 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3569 s1=scalar2(b1(1,iti2),auxvec(1))
3570 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3571 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3572 s2=scalar2(b1(1,iti1),auxvec(1))
3573 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3574 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3575 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3576 write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3577 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3581 C-----------------------------------------------------------------------------
3582 subroutine vecpr(u,v,w)
3583 implicit real*8(a-h,o-z)
3584 dimension u(3),v(3),w(3)
3585 w(1)=u(2)*v(3)-u(3)*v(2)
3586 w(2)=-u(1)*v(3)+u(3)*v(1)
3587 w(3)=u(1)*v(2)-u(2)*v(1)
3590 C-----------------------------------------------------------------------------
3591 subroutine unormderiv(u,ugrad,unorm,ungrad)
3592 C This subroutine computes the derivatives of a normalized vector u, given
3593 C the derivatives computed without normalization conditions, ugrad. Returns
3596 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3597 double precision vec(3)
3598 double precision scalar
3600 c write (2,*) 'ugrad',ugrad
3603 vec(i)=scalar(ugrad(1,i),u(1))
3605 c write (2,*) 'vec',vec
3608 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3611 c write (2,*) 'ungrad',ungrad
3614 C-----------------------------------------------------------------------------
3615 subroutine escp_soft_sphere(evdw2,evdw2_14)
3617 C This subroutine calculates the excluded-volume interaction energy between
3618 C peptide-group centers and side chains and its gradient in virtual-bond and
3619 C side-chain vectors.
3621 implicit real*8 (a-h,o-z)
3622 include 'DIMENSIONS'
3623 include 'COMMON.GEO'
3624 include 'COMMON.VAR'
3625 include 'COMMON.LOCAL'
3626 include 'COMMON.CHAIN'
3627 include 'COMMON.DERIV'
3628 include 'COMMON.INTERACT'
3629 include 'COMMON.FFIELD'
3630 include 'COMMON.IOUNITS'
3631 include 'COMMON.CONTROL'
3636 cd print '(a)','Enter ESCP'
3637 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3638 do i=iatscp_s,iatscp_e
3640 xi=0.5D0*(c(1,i)+c(1,i+1))
3641 yi=0.5D0*(c(2,i)+c(2,i+1))
3642 zi=0.5D0*(c(3,i)+c(3,i+1))
3644 do iint=1,nscp_gr(i)
3646 do j=iscpstart(i,iint),iscpend(i,iint)
3648 C Uncomment following three lines for SC-p interactions
3652 C Uncomment following three lines for Ca-p interactions
3656 rij=xj*xj+yj*yj+zj*zj
3659 if (rij.lt.r0ijsq) then
3660 evdwij=0.25d0*(rij-r0ijsq)**2
3668 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3674 cd write (iout,*) 'j<i'
3675 C Uncomment following three lines for SC-p interactions
3677 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3680 cd write (iout,*) 'j>i'
3683 C Uncomment following line for SC-p interactions
3684 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3688 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3692 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3693 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3696 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3705 C-----------------------------------------------------------------------------
3706 subroutine escp(evdw2,evdw2_14)
3708 C This subroutine calculates the excluded-volume interaction energy between
3709 C peptide-group centers and side chains and its gradient in virtual-bond and
3710 C side-chain vectors.
3712 implicit real*8 (a-h,o-z)
3713 include 'DIMENSIONS'
3714 include 'COMMON.GEO'
3715 include 'COMMON.VAR'
3716 include 'COMMON.LOCAL'
3717 include 'COMMON.CHAIN'
3718 include 'COMMON.DERIV'
3719 include 'COMMON.INTERACT'
3720 include 'COMMON.FFIELD'
3721 include 'COMMON.IOUNITS'
3722 include 'COMMON.CONTROL'
3726 cd print '(a)','Enter ESCP'
3727 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3728 do i=iatscp_s,iatscp_e
3730 xi=0.5D0*(c(1,i)+c(1,i+1))
3731 yi=0.5D0*(c(2,i)+c(2,i+1))
3732 zi=0.5D0*(c(3,i)+c(3,i+1))
3734 do iint=1,nscp_gr(i)
3736 do j=iscpstart(i,iint),iscpend(i,iint)
3738 C Uncomment following three lines for SC-p interactions
3742 C Uncomment following three lines for Ca-p interactions
3746 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3748 e1=fac*fac*aad(itypj,iteli)
3749 e2=fac*bad(itypj,iteli)
3750 if (iabs(j-i) .le. 2) then
3753 evdw2_14=evdw2_14+e1+e2
3757 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3758 & 'evdw2',i,j,evdwij
3760 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3762 fac=-(evdwij+e1)*rrij
3766 cgrad if (j.lt.i) then
3767 cd write (iout,*) 'j<i'
3768 C Uncomment following three lines for SC-p interactions
3770 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3773 cd write (iout,*) 'j>i'
3775 cgrad ggg(k)=-ggg(k)
3776 C Uncomment following line for SC-p interactions
3777 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3778 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3782 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3784 cgrad kstart=min0(i+1,j)
3785 cgrad kend=max0(i-1,j-1)
3786 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3787 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3788 cgrad do k=kstart,kend
3790 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3794 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3795 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3803 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3804 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
3805 gradx_scp(j,i)=expon*gradx_scp(j,i)
3808 C******************************************************************************
3812 C To save time the factor EXPON has been extracted from ALL components
3813 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3816 C******************************************************************************
3819 C--------------------------------------------------------------------------
3820 subroutine edis(ehpb)
3822 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3824 implicit real*8 (a-h,o-z)
3825 include 'DIMENSIONS'
3826 include 'COMMON.SBRIDGE'
3827 include 'COMMON.CHAIN'
3828 include 'COMMON.DERIV'
3829 include 'COMMON.VAR'
3830 include 'COMMON.INTERACT'
3833 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3834 cd print *,'link_start=',link_start,' link_end=',link_end
3835 if (link_end.eq.0) return
3836 do i=link_start,link_end
3837 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3838 C CA-CA distance used in regularization of structure.
3841 C iii and jjj point to the residues for which the distance is assigned.
3842 if (ii.gt.nres) then
3849 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3850 C distance and angle dependent SS bond potential.
3851 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3852 call ssbond_ene(iii,jjj,eij)
3855 C Calculate the distance between the two points and its difference from the
3859 C Get the force constant corresponding to this distance.
3861 C Calculate the contribution to energy.
3862 ehpb=ehpb+waga*rdis*rdis
3864 C Evaluate gradient.
3867 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3868 cd & ' waga=',waga,' fac=',fac
3870 ggg(j)=fac*(c(j,jj)-c(j,ii))
3872 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3873 C If this is a SC-SC distance, we need to calculate the contributions to the
3874 C Cartesian gradient in the SC vectors (ghpbx).
3877 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3878 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3883 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3891 C--------------------------------------------------------------------------
3892 subroutine ssbond_ene(i,j,eij)
3894 C Calculate the distance and angle dependent SS-bond potential energy
3895 C using a free-energy function derived based on RHF/6-31G** ab initio
3896 C calculations of diethyl disulfide.
3898 C A. Liwo and U. Kozlowska, 11/24/03
3900 implicit real*8 (a-h,o-z)
3901 include 'DIMENSIONS'
3902 include 'COMMON.SBRIDGE'
3903 include 'COMMON.CHAIN'
3904 include 'COMMON.DERIV'
3905 include 'COMMON.LOCAL'
3906 include 'COMMON.INTERACT'
3907 include 'COMMON.VAR'
3908 include 'COMMON.IOUNITS'
3909 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3914 dxi=dc_norm(1,nres+i)
3915 dyi=dc_norm(2,nres+i)
3916 dzi=dc_norm(3,nres+i)
3917 dsci_inv=dsc_inv(itypi)
3919 dscj_inv=dsc_inv(itypj)
3923 dxj=dc_norm(1,nres+j)
3924 dyj=dc_norm(2,nres+j)
3925 dzj=dc_norm(3,nres+j)
3926 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3931 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3932 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3933 om12=dxi*dxj+dyi*dyj+dzi*dzj
3935 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3936 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3942 deltat12=om2-om1+2.0d0
3944 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3945 & +akct*deltad*deltat12
3946 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3947 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3948 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3949 c & " deltat12",deltat12," eij",eij
3950 ed=2*akcm*deltad+akct*deltat12
3952 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3953 eom1=-2*akth*deltat1-pom1-om2*pom2
3954 eom2= 2*akth*deltat2+pom1-om1*pom2
3957 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3960 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3961 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3962 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3963 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3966 C Calculate the components of the gradient in DC and X
3970 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3975 C--------------------------------------------------------------------------
3976 subroutine ebond(estr)
3978 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3980 implicit real*8 (a-h,o-z)
3981 include 'DIMENSIONS'
3982 include 'COMMON.LOCAL'
3983 include 'COMMON.GEO'
3984 include 'COMMON.INTERACT'
3985 include 'COMMON.DERIV'
3986 include 'COMMON.VAR'
3987 include 'COMMON.CHAIN'
3988 include 'COMMON.IOUNITS'
3989 include 'COMMON.NAMES'
3990 include 'COMMON.FFIELD'
3991 include 'COMMON.CONTROL'
3992 include 'COMMON.SETUP'
3993 double precision u(3),ud(3)
3995 do i=ibondp_start,ibondp_end
3996 diff = vbld(i)-vbldp0
3997 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4000 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4002 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4006 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4008 do i=ibond_start,ibond_end
4013 diff=vbld(i+nres)-vbldsc0(1,iti)
4014 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4015 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4016 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4018 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4022 diff=vbld(i+nres)-vbldsc0(j,iti)
4023 ud(j)=aksc(j,iti)*diff
4024 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4038 uprod2=uprod2*u(k)*u(k)
4042 usumsqder=usumsqder+ud(j)*uprod2
4044 estr=estr+uprod/usum
4046 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4054 C--------------------------------------------------------------------------
4055 subroutine ebend(etheta)
4057 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4058 C angles gamma and its derivatives in consecutive thetas and gammas.
4060 implicit real*8 (a-h,o-z)
4061 include 'DIMENSIONS'
4062 include 'COMMON.LOCAL'
4063 include 'COMMON.GEO'
4064 include 'COMMON.INTERACT'
4065 include 'COMMON.DERIV'
4066 include 'COMMON.VAR'
4067 include 'COMMON.CHAIN'
4068 include 'COMMON.IOUNITS'
4069 include 'COMMON.NAMES'
4070 include 'COMMON.FFIELD'
4071 include 'COMMON.CONTROL'
4072 common /calcthet/ term1,term2,termm,diffak,ratak,
4073 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4074 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4075 double precision y(2),z(2)
4077 c time11=dexp(-2*time)
4080 c write (*,'(a,i2)') 'EBEND ICG=',icg
4081 do i=ithet_start,ithet_end
4082 C Zero the energy function and its derivative at 0 or pi.
4083 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4088 if (phii.ne.phii) phii=150.0
4101 if (phii1.ne.phii1) phii1=150.0
4113 C Calculate the "mean" value of theta from the part of the distribution
4114 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4115 C In following comments this theta will be referred to as t_c.
4116 thet_pred_mean=0.0d0
4120 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4122 dthett=thet_pred_mean*ssd
4123 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4124 C Derivatives of the "mean" values in gamma1 and gamma2.
4125 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4126 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4127 if (theta(i).gt.pi-delta) then
4128 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4130 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4131 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4132 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4134 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4136 else if (theta(i).lt.delta) then
4137 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4138 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4139 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4141 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4142 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4145 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4148 etheta=etheta+ethetai
4149 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4151 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4152 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4153 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4155 C Ufff.... We've done all this!!!
4158 C---------------------------------------------------------------------------
4159 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4161 implicit real*8 (a-h,o-z)
4162 include 'DIMENSIONS'
4163 include 'COMMON.LOCAL'
4164 include 'COMMON.IOUNITS'
4165 common /calcthet/ term1,term2,termm,diffak,ratak,
4166 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4167 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4168 C Calculate the contributions to both Gaussian lobes.
4169 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4170 C The "polynomial part" of the "standard deviation" of this part of
4174 sig=sig*thet_pred_mean+polthet(j,it)
4176 C Derivative of the "interior part" of the "standard deviation of the"
4177 C gamma-dependent Gaussian lobe in t_c.
4178 sigtc=3*polthet(3,it)
4180 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4183 C Set the parameters of both Gaussian lobes of the distribution.
4184 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4185 fac=sig*sig+sigc0(it)
4188 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4189 sigsqtc=-4.0D0*sigcsq*sigtc
4190 c print *,i,sig,sigtc,sigsqtc
4191 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4192 sigtc=-sigtc/(fac*fac)
4193 C Following variable is sigma(t_c)**(-2)
4194 sigcsq=sigcsq*sigcsq
4196 sig0inv=1.0D0/sig0i**2
4197 delthec=thetai-thet_pred_mean
4198 delthe0=thetai-theta0i
4199 term1=-0.5D0*sigcsq*delthec*delthec
4200 term2=-0.5D0*sig0inv*delthe0*delthe0
4201 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4202 C NaNs in taking the logarithm. We extract the largest exponent which is added
4203 C to the energy (this being the log of the distribution) at the end of energy
4204 C term evaluation for this virtual-bond angle.
4205 if (term1.gt.term2) then
4207 term2=dexp(term2-termm)
4211 term1=dexp(term1-termm)
4214 C The ratio between the gamma-independent and gamma-dependent lobes of
4215 C the distribution is a Gaussian function of thet_pred_mean too.
4216 diffak=gthet(2,it)-thet_pred_mean
4217 ratak=diffak/gthet(3,it)**2
4218 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4219 C Let's differentiate it in thet_pred_mean NOW.
4221 C Now put together the distribution terms to make complete distribution.
4222 termexp=term1+ak*term2
4223 termpre=sigc+ak*sig0i
4224 C Contribution of the bending energy from this theta is just the -log of
4225 C the sum of the contributions from the two lobes and the pre-exponential
4226 C factor. Simple enough, isn't it?
4227 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4228 C NOW the derivatives!!!
4229 C 6/6/97 Take into account the deformation.
4230 E_theta=(delthec*sigcsq*term1
4231 & +ak*delthe0*sig0inv*term2)/termexp
4232 E_tc=((sigtc+aktc*sig0i)/termpre
4233 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4234 & aktc*term2)/termexp)
4237 c-----------------------------------------------------------------------------
4238 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4239 implicit real*8 (a-h,o-z)
4240 include 'DIMENSIONS'
4241 include 'COMMON.LOCAL'
4242 include 'COMMON.IOUNITS'
4243 common /calcthet/ term1,term2,termm,diffak,ratak,
4244 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4245 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4246 delthec=thetai-thet_pred_mean
4247 delthe0=thetai-theta0i
4248 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4249 t3 = thetai-thet_pred_mean
4253 t14 = t12+t6*sigsqtc
4255 t21 = thetai-theta0i
4261 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4262 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4263 & *(-t12*t9-ak*sig0inv*t27)
4267 C--------------------------------------------------------------------------
4268 subroutine ebend(etheta)
4270 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4271 C angles gamma and its derivatives in consecutive thetas and gammas.
4272 C ab initio-derived potentials from
4273 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4275 implicit real*8 (a-h,o-z)
4276 include 'DIMENSIONS'
4277 include 'COMMON.LOCAL'
4278 include 'COMMON.GEO'
4279 include 'COMMON.INTERACT'
4280 include 'COMMON.DERIV'
4281 include 'COMMON.VAR'
4282 include 'COMMON.CHAIN'
4283 include 'COMMON.IOUNITS'
4284 include 'COMMON.NAMES'
4285 include 'COMMON.FFIELD'
4286 include 'COMMON.CONTROL'
4287 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4288 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4289 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4290 & sinph1ph2(maxdouble,maxdouble)
4291 logical lprn /.false./, lprn1 /.false./
4293 do i=ithet_start,ithet_end
4297 theti2=0.5d0*theta(i)
4298 ityp2=ithetyp(itype(i-1))
4300 coskt(k)=dcos(k*theti2)
4301 sinkt(k)=dsin(k*theti2)
4306 if (phii.ne.phii) phii=150.0
4310 ityp1=ithetyp(itype(i-2))
4312 cosph1(k)=dcos(k*phii)
4313 sinph1(k)=dsin(k*phii)
4326 if (phii1.ne.phii1) phii1=150.0
4331 ityp3=ithetyp(itype(i))
4333 cosph2(k)=dcos(k*phii1)
4334 sinph2(k)=dsin(k*phii1)
4344 ethetai=aa0thet(ityp1,ityp2,ityp3)
4347 ccl=cosph1(l)*cosph2(k-l)
4348 ssl=sinph1(l)*sinph2(k-l)
4349 scl=sinph1(l)*cosph2(k-l)
4350 csl=cosph1(l)*sinph2(k-l)
4351 cosph1ph2(l,k)=ccl-ssl
4352 cosph1ph2(k,l)=ccl+ssl
4353 sinph1ph2(l,k)=scl+csl
4354 sinph1ph2(k,l)=scl-csl
4358 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4359 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4360 write (iout,*) "coskt and sinkt"
4362 write (iout,*) k,coskt(k),sinkt(k)
4366 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4367 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4370 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4371 & " ethetai",ethetai
4374 write (iout,*) "cosph and sinph"
4376 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4378 write (iout,*) "cosph1ph2 and sinph2ph2"
4381 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4382 & sinph1ph2(l,k),sinph1ph2(k,l)
4385 write(iout,*) "ethetai",ethetai
4389 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4390 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4391 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4392 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4393 ethetai=ethetai+sinkt(m)*aux
4394 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4395 dephii=dephii+k*sinkt(m)*(
4396 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4397 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4398 dephii1=dephii1+k*sinkt(m)*(
4399 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4400 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4402 & write (iout,*) "m",m," k",k," bbthet",
4403 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4404 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4405 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4406 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4410 & write(iout,*) "ethetai",ethetai
4414 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4415 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4416 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4417 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4418 ethetai=ethetai+sinkt(m)*aux
4419 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4420 dephii=dephii+l*sinkt(m)*(
4421 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4422 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4423 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4424 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4425 dephii1=dephii1+(k-l)*sinkt(m)*(
4426 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4427 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4428 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4429 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4431 write (iout,*) "m",m," k",k," l",l," ffthet",
4432 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4433 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4434 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4435 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4436 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4437 & cosph1ph2(k,l)*sinkt(m),
4438 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4444 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4445 & i,theta(i)*rad2deg,phii*rad2deg,
4446 & phii1*rad2deg,ethetai
4447 etheta=etheta+ethetai
4448 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4449 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4450 gloc(nphi+i-2,icg)=wang*dethetai
4456 c-----------------------------------------------------------------------------
4457 subroutine esc(escloc)
4458 C Calculate the local energy of a side chain and its derivatives in the
4459 C corresponding virtual-bond valence angles THETA and the spherical angles
4461 implicit real*8 (a-h,o-z)
4462 include 'DIMENSIONS'
4463 include 'COMMON.GEO'
4464 include 'COMMON.LOCAL'
4465 include 'COMMON.VAR'
4466 include 'COMMON.INTERACT'
4467 include 'COMMON.DERIV'
4468 include 'COMMON.CHAIN'
4469 include 'COMMON.IOUNITS'
4470 include 'COMMON.NAMES'
4471 include 'COMMON.FFIELD'
4472 include 'COMMON.CONTROL'
4473 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4474 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4475 common /sccalc/ time11,time12,time112,theti,it,nlobit
4478 c write (iout,'(a)') 'ESC'
4479 do i=loc_start,loc_end
4481 if (it.eq.10) goto 1
4483 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4484 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4485 theti=theta(i+1)-pipol
4490 if (x(2).gt.pi-delta) then
4494 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4496 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4497 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4499 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4500 & ddersc0(1),dersc(1))
4501 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4502 & ddersc0(3),dersc(3))
4504 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4506 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4507 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4508 & dersc0(2),esclocbi,dersc02)
4509 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4511 call splinthet(x(2),0.5d0*delta,ss,ssd)
4516 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4518 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4519 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4521 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4523 c write (iout,*) escloci
4524 else if (x(2).lt.delta) then
4528 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4530 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4531 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4533 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4534 & ddersc0(1),dersc(1))
4535 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4536 & ddersc0(3),dersc(3))
4538 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4540 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4541 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4542 & dersc0(2),esclocbi,dersc02)
4543 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4548 call splinthet(x(2),0.5d0*delta,ss,ssd)
4550 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4552 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4553 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4555 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4556 c write (iout,*) escloci
4558 call enesc(x,escloci,dersc,ddummy,.false.)
4561 escloc=escloc+escloci
4562 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4563 & 'escloc',i,escloci
4564 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4566 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4568 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4569 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4574 C---------------------------------------------------------------------------
4575 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4576 implicit real*8 (a-h,o-z)
4577 include 'DIMENSIONS'
4578 include 'COMMON.GEO'
4579 include 'COMMON.LOCAL'
4580 include 'COMMON.IOUNITS'
4581 common /sccalc/ time11,time12,time112,theti,it,nlobit
4582 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4583 double precision contr(maxlob,-1:1)
4585 c write (iout,*) 'it=',it,' nlobit=',nlobit
4589 if (mixed) ddersc(j)=0.0d0
4593 C Because of periodicity of the dependence of the SC energy in omega we have
4594 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4595 C To avoid underflows, first compute & store the exponents.
4603 z(k)=x(k)-censc(k,j,it)
4608 Axk=Axk+gaussc(l,k,j,it)*z(l)
4614 expfac=expfac+Ax(k,j,iii)*z(k)
4622 C As in the case of ebend, we want to avoid underflows in exponentiation and
4623 C subsequent NaNs and INFs in energy calculation.
4624 C Find the largest exponent
4628 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4632 cd print *,'it=',it,' emin=',emin
4634 C Compute the contribution to SC energy and derivatives
4639 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4640 if(adexp.ne.adexp) adexp=1.0
4643 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4645 cd print *,'j=',j,' expfac=',expfac
4646 escloc_i=escloc_i+expfac
4648 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4652 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4653 & +gaussc(k,2,j,it))*expfac
4660 dersc(1)=dersc(1)/cos(theti)**2
4661 ddersc(1)=ddersc(1)/cos(theti)**2
4664 escloci=-(dlog(escloc_i)-emin)
4666 dersc(j)=dersc(j)/escloc_i
4670 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4675 C------------------------------------------------------------------------------
4676 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4677 implicit real*8 (a-h,o-z)
4678 include 'DIMENSIONS'
4679 include 'COMMON.GEO'
4680 include 'COMMON.LOCAL'
4681 include 'COMMON.IOUNITS'
4682 common /sccalc/ time11,time12,time112,theti,it,nlobit
4683 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4684 double precision contr(maxlob)
4695 z(k)=x(k)-censc(k,j,it)
4701 Axk=Axk+gaussc(l,k,j,it)*z(l)
4707 expfac=expfac+Ax(k,j)*z(k)
4712 C As in the case of ebend, we want to avoid underflows in exponentiation and
4713 C subsequent NaNs and INFs in energy calculation.
4714 C Find the largest exponent
4717 if (emin.gt.contr(j)) emin=contr(j)
4721 C Compute the contribution to SC energy and derivatives
4725 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4726 escloc_i=escloc_i+expfac
4728 dersc(k)=dersc(k)+Ax(k,j)*expfac
4730 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4731 & +gaussc(1,2,j,it))*expfac
4735 dersc(1)=dersc(1)/cos(theti)**2
4736 dersc12=dersc12/cos(theti)**2
4737 escloci=-(dlog(escloc_i)-emin)
4739 dersc(j)=dersc(j)/escloc_i
4741 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4745 c----------------------------------------------------------------------------------
4746 subroutine esc(escloc)
4747 C Calculate the local energy of a side chain and its derivatives in the
4748 C corresponding virtual-bond valence angles THETA and the spherical angles
4749 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4750 C added by Urszula Kozlowska. 07/11/2007
4752 implicit real*8 (a-h,o-z)
4753 include 'DIMENSIONS'
4754 include 'COMMON.GEO'
4755 include 'COMMON.LOCAL'
4756 include 'COMMON.VAR'
4757 include 'COMMON.SCROT'
4758 include 'COMMON.INTERACT'
4759 include 'COMMON.DERIV'
4760 include 'COMMON.CHAIN'
4761 include 'COMMON.IOUNITS'
4762 include 'COMMON.NAMES'
4763 include 'COMMON.FFIELD'
4764 include 'COMMON.CONTROL'
4765 include 'COMMON.VECTORS'
4766 double precision x_prime(3),y_prime(3),z_prime(3)
4767 & , sumene,dsc_i,dp2_i,x(65),
4768 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4769 & de_dxx,de_dyy,de_dzz,de_dt
4770 double precision s1_t,s1_6_t,s2_t,s2_6_t
4772 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4773 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4774 & dt_dCi(3),dt_dCi1(3)
4775 common /sccalc/ time11,time12,time112,theti,it,nlobit
4778 do i=loc_start,loc_end
4779 costtab(i+1) =dcos(theta(i+1))
4780 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4781 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4782 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4783 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4784 cosfac=dsqrt(cosfac2)
4785 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4786 sinfac=dsqrt(sinfac2)
4788 if (it.eq.10) goto 1
4790 C Compute the axes of tghe local cartesian coordinates system; store in
4791 c x_prime, y_prime and z_prime
4798 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4799 C & dc_norm(3,i+nres)
4801 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4802 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4805 z_prime(j) = -uz(j,i-1)
4808 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4809 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4810 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4811 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4812 c & " xy",scalar(x_prime(1),y_prime(1)),
4813 c & " xz",scalar(x_prime(1),z_prime(1)),
4814 c & " yy",scalar(y_prime(1),y_prime(1)),
4815 c & " yz",scalar(y_prime(1),z_prime(1)),
4816 c & " zz",scalar(z_prime(1),z_prime(1))
4818 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4819 C to local coordinate system. Store in xx, yy, zz.
4825 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4826 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4827 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4834 C Compute the energy of the ith side cbain
4836 c write (2,*) "xx",xx," yy",yy," zz",zz
4839 x(j) = sc_parmin(j,it)
4842 Cc diagnostics - remove later
4844 yy1 = dsin(alph(2))*dcos(omeg(2))
4845 zz1 = -dsin(alph(2))*dsin(omeg(2))
4846 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4847 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4849 C," --- ", xx_w,yy_w,zz_w
4852 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4853 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4855 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4856 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4858 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4859 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4860 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4861 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4862 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4864 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4865 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4866 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4867 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4868 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4870 dsc_i = 0.743d0+x(61)
4872 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4873 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4874 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4875 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4876 s1=(1+x(63))/(0.1d0 + dscp1)
4877 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4878 s2=(1+x(65))/(0.1d0 + dscp2)
4879 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4880 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4881 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4882 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4884 c & dscp1,dscp2,sumene
4885 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4886 escloc = escloc + sumene
4887 c write (2,*) "i",i," escloc",sumene,escloc
4890 C This section to check the numerical derivatives of the energy of ith side
4891 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4892 C #define DEBUG in the code to turn it on.
4894 write (2,*) "sumene =",sumene
4898 write (2,*) xx,yy,zz
4899 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4900 de_dxx_num=(sumenep-sumene)/aincr
4902 write (2,*) "xx+ sumene from enesc=",sumenep
4905 write (2,*) xx,yy,zz
4906 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4907 de_dyy_num=(sumenep-sumene)/aincr
4909 write (2,*) "yy+ sumene from enesc=",sumenep
4912 write (2,*) xx,yy,zz
4913 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4914 de_dzz_num=(sumenep-sumene)/aincr
4916 write (2,*) "zz+ sumene from enesc=",sumenep
4917 costsave=cost2tab(i+1)
4918 sintsave=sint2tab(i+1)
4919 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4920 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4921 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4922 de_dt_num=(sumenep-sumene)/aincr
4923 write (2,*) " t+ sumene from enesc=",sumenep
4924 cost2tab(i+1)=costsave
4925 sint2tab(i+1)=sintsave
4926 C End of diagnostics section.
4929 C Compute the gradient of esc
4931 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4932 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4933 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4934 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4935 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4936 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4937 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4938 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4939 pom1=(sumene3*sint2tab(i+1)+sumene1)
4940 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4941 pom2=(sumene4*cost2tab(i+1)+sumene2)
4942 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4943 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4944 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4945 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4947 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4948 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4949 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4951 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4952 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4953 & +(pom1+pom2)*pom_dx
4955 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4958 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4959 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4960 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4962 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4963 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4964 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4965 & +x(59)*zz**2 +x(60)*xx*zz
4966 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4967 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4968 & +(pom1-pom2)*pom_dy
4970 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4973 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4974 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4975 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4976 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4977 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4978 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4979 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4980 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4982 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4985 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4986 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4987 & +pom1*pom_dt1+pom2*pom_dt2
4989 write(2,*), "de_dt = ", de_dt,de_dt_num
4993 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4994 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4995 cosfac2xx=cosfac2*xx
4996 sinfac2yy=sinfac2*yy
4998 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5000 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5002 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5003 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5004 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5005 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5006 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5007 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5008 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5009 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5010 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5011 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5015 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5016 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5019 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5020 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5021 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5023 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5024 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5028 dXX_Ctab(k,i)=dXX_Ci(k)
5029 dXX_C1tab(k,i)=dXX_Ci1(k)
5030 dYY_Ctab(k,i)=dYY_Ci(k)
5031 dYY_C1tab(k,i)=dYY_Ci1(k)
5032 dZZ_Ctab(k,i)=dZZ_Ci(k)
5033 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5034 dXX_XYZtab(k,i)=dXX_XYZ(k)
5035 dYY_XYZtab(k,i)=dYY_XYZ(k)
5036 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5040 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5041 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5042 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5043 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5044 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5046 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5047 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5048 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5049 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5050 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5051 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5052 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5053 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5055 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5056 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5058 C to check gradient call subroutine check_grad
5064 c------------------------------------------------------------------------------
5065 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5067 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5068 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5069 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5070 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5072 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5073 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5075 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5076 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5077 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5078 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5079 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5081 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5082 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5083 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5084 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5085 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5087 dsc_i = 0.743d0+x(61)
5089 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5090 & *(xx*cost2+yy*sint2))
5091 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5092 & *(xx*cost2-yy*sint2))
5093 s1=(1+x(63))/(0.1d0 + dscp1)
5094 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5095 s2=(1+x(65))/(0.1d0 + dscp2)
5096 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5097 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5098 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5103 c------------------------------------------------------------------------------
5104 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5106 C This procedure calculates two-body contact function g(rij) and its derivative:
5109 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5112 C where x=(rij-r0ij)/delta
5114 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5117 double precision rij,r0ij,eps0ij,fcont,fprimcont
5118 double precision x,x2,x4,delta
5122 if (x.lt.-1.0D0) then
5125 else if (x.le.1.0D0) then
5128 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5129 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5136 c------------------------------------------------------------------------------
5137 subroutine splinthet(theti,delta,ss,ssder)
5138 implicit real*8 (a-h,o-z)
5139 include 'DIMENSIONS'
5140 include 'COMMON.VAR'
5141 include 'COMMON.GEO'
5144 if (theti.gt.pipol) then
5145 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5147 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5152 c------------------------------------------------------------------------------
5153 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5155 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5156 double precision ksi,ksi2,ksi3,a1,a2,a3
5157 a1=fprim0*delta/(f1-f0)
5163 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5164 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5167 c------------------------------------------------------------------------------
5168 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5170 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5171 double precision ksi,ksi2,ksi3,a1,a2,a3
5176 a2=3*(f1x-f0x)-2*fprim0x*delta
5177 a3=fprim0x*delta-2*(f1x-f0x)
5178 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5181 C-----------------------------------------------------------------------------
5183 C-----------------------------------------------------------------------------
5184 subroutine etor(etors,edihcnstr)
5185 implicit real*8 (a-h,o-z)
5186 include 'DIMENSIONS'
5187 include 'COMMON.VAR'
5188 include 'COMMON.GEO'
5189 include 'COMMON.LOCAL'
5190 include 'COMMON.TORSION'
5191 include 'COMMON.INTERACT'
5192 include 'COMMON.DERIV'
5193 include 'COMMON.CHAIN'
5194 include 'COMMON.NAMES'
5195 include 'COMMON.IOUNITS'
5196 include 'COMMON.FFIELD'
5197 include 'COMMON.TORCNSTR'
5198 include 'COMMON.CONTROL'
5200 C Set lprn=.true. for debugging
5204 do i=iphi_start,iphi_end
5206 itori=itortyp(itype(i-2))
5207 itori1=itortyp(itype(i-1))
5210 C Proline-Proline pair is a special case...
5211 if (itori.eq.3 .and. itori1.eq.3) then
5212 if (phii.gt.-dwapi3) then
5214 fac=1.0D0/(1.0D0-cosphi)
5215 etorsi=v1(1,3,3)*fac
5216 etorsi=etorsi+etorsi
5217 etors=etors+etorsi-v1(1,3,3)
5218 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5219 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5222 v1ij=v1(j+1,itori,itori1)
5223 v2ij=v2(j+1,itori,itori1)
5226 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5227 if (energy_dec) etors_ii=etors_ii+
5228 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5229 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5233 v1ij=v1(j,itori,itori1)
5234 v2ij=v2(j,itori,itori1)
5237 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5238 if (energy_dec) etors_ii=etors_ii+
5239 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5240 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5243 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5246 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5247 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5248 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5249 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5250 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5252 ! 6/20/98 - dihedral angle constraints
5255 itori=idih_constr(i)
5258 if (difi.gt.drange(i)) then
5260 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5261 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5262 else if (difi.lt.-drange(i)) then
5264 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5265 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5267 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5268 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5270 ! write (iout,*) 'edihcnstr',edihcnstr
5273 c------------------------------------------------------------------------------
5274 subroutine etor_d(etors_d)
5278 c----------------------------------------------------------------------------
5280 subroutine etor(etors,edihcnstr)
5281 implicit real*8 (a-h,o-z)
5282 include 'DIMENSIONS'
5283 include 'COMMON.VAR'
5284 include 'COMMON.GEO'
5285 include 'COMMON.LOCAL'
5286 include 'COMMON.TORSION'
5287 include 'COMMON.INTERACT'
5288 include 'COMMON.DERIV'
5289 include 'COMMON.CHAIN'
5290 include 'COMMON.NAMES'
5291 include 'COMMON.IOUNITS'
5292 include 'COMMON.FFIELD'
5293 include 'COMMON.TORCNSTR'
5294 include 'COMMON.CONTROL'
5296 C Set lprn=.true. for debugging
5300 do i=iphi_start,iphi_end
5302 itori=itortyp(itype(i-2))
5303 itori1=itortyp(itype(i-1))
5306 C Regular cosine and sine terms
5307 do j=1,nterm(itori,itori1)
5308 v1ij=v1(j,itori,itori1)
5309 v2ij=v2(j,itori,itori1)
5312 etors=etors+v1ij*cosphi+v2ij*sinphi
5313 if (energy_dec) etors_ii=etors_ii+
5314 & v1ij*cosphi+v2ij*sinphi
5315 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5319 C E = SUM ----------------------------------- - v1
5320 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5322 cosphi=dcos(0.5d0*phii)
5323 sinphi=dsin(0.5d0*phii)
5324 do j=1,nlor(itori,itori1)
5325 vl1ij=vlor1(j,itori,itori1)
5326 vl2ij=vlor2(j,itori,itori1)
5327 vl3ij=vlor3(j,itori,itori1)
5328 pom=vl2ij*cosphi+vl3ij*sinphi
5329 pom1=1.0d0/(pom*pom+1.0d0)
5330 etors=etors+vl1ij*pom1
5331 if (energy_dec) etors_ii=etors_ii+
5334 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5336 C Subtract the constant term
5337 etors=etors-v0(itori,itori1)
5338 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5339 & 'etor',i,etors_ii-v0(itori,itori1)
5341 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5342 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5343 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5344 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5345 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5347 ! 6/20/98 - dihedral angle constraints
5349 c do i=1,ndih_constr
5350 do i=idihconstr_start,idihconstr_end
5351 itori=idih_constr(i)
5353 difi=pinorm(phii-phi0(i))
5354 if (difi.gt.drange(i)) then
5356 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5357 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5358 else if (difi.lt.-drange(i)) then
5360 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5361 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5365 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5366 cd & rad2deg*phi0(i), rad2deg*drange(i),
5367 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5369 cd write (iout,*) 'edihcnstr',edihcnstr
5372 c----------------------------------------------------------------------------
5373 subroutine etor_d(etors_d)
5374 C 6/23/01 Compute double torsional energy
5375 implicit real*8 (a-h,o-z)
5376 include 'DIMENSIONS'
5377 include 'COMMON.VAR'
5378 include 'COMMON.GEO'
5379 include 'COMMON.LOCAL'
5380 include 'COMMON.TORSION'
5381 include 'COMMON.INTERACT'
5382 include 'COMMON.DERIV'
5383 include 'COMMON.CHAIN'
5384 include 'COMMON.NAMES'
5385 include 'COMMON.IOUNITS'
5386 include 'COMMON.FFIELD'
5387 include 'COMMON.TORCNSTR'
5389 C Set lprn=.true. for debugging
5393 do i=iphid_start,iphid_end
5394 itori=itortyp(itype(i-2))
5395 itori1=itortyp(itype(i-1))
5396 itori2=itortyp(itype(i))
5401 C Regular cosine and sine terms
5402 do j=1,ntermd_1(itori,itori1,itori2)
5403 v1cij=v1c(1,j,itori,itori1,itori2)
5404 v1sij=v1s(1,j,itori,itori1,itori2)
5405 v2cij=v1c(2,j,itori,itori1,itori2)
5406 v2sij=v1s(2,j,itori,itori1,itori2)
5407 cosphi1=dcos(j*phii)
5408 sinphi1=dsin(j*phii)
5409 cosphi2=dcos(j*phii1)
5410 sinphi2=dsin(j*phii1)
5411 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5412 & v2cij*cosphi2+v2sij*sinphi2
5413 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5414 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5416 do k=2,ntermd_2(itori,itori1,itori2)
5418 v1cdij = v2c(k,l,itori,itori1,itori2)
5419 v2cdij = v2c(l,k,itori,itori1,itori2)
5420 v1sdij = v2s(k,l,itori,itori1,itori2)
5421 v2sdij = v2s(l,k,itori,itori1,itori2)
5422 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5423 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5424 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5425 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5426 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5427 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5428 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5429 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5430 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5431 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5434 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5435 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5440 c------------------------------------------------------------------------------
5441 subroutine eback_sc_corr(esccor)
5442 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5443 c conformational states; temporarily implemented as differences
5444 c between UNRES torsional potentials (dependent on three types of
5445 c residues) and the torsional potentials dependent on all 20 types
5446 c of residues computed from AM1 energy surfaces of terminally-blocked
5447 c amino-acid residues.
5448 implicit real*8 (a-h,o-z)
5449 include 'DIMENSIONS'
5450 include 'COMMON.VAR'
5451 include 'COMMON.GEO'
5452 include 'COMMON.LOCAL'
5453 include 'COMMON.TORSION'
5454 include 'COMMON.SCCOR'
5455 include 'COMMON.INTERACT'
5456 include 'COMMON.DERIV'
5457 include 'COMMON.CHAIN'
5458 include 'COMMON.NAMES'
5459 include 'COMMON.IOUNITS'
5460 include 'COMMON.FFIELD'
5461 include 'COMMON.CONTROL'
5463 C Set lprn=.true. for debugging
5466 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5468 do i=iphi_start,iphi_end
5475 v1ij=v1sccor(j,itori,itori1)
5476 v2ij=v2sccor(j,itori,itori1)
5479 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5480 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5483 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5484 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5485 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5486 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5490 c----------------------------------------------------------------------------
5491 subroutine multibody(ecorr)
5492 C This subroutine calculates multi-body contributions to energy following
5493 C the idea of Skolnick et al. If side chains I and J make a contact and
5494 C at the same time side chains I+1 and J+1 make a contact, an extra
5495 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5496 implicit real*8 (a-h,o-z)
5497 include 'DIMENSIONS'
5498 include 'COMMON.IOUNITS'
5499 include 'COMMON.DERIV'
5500 include 'COMMON.INTERACT'
5501 include 'COMMON.CONTACTS'
5502 double precision gx(3),gx1(3)
5505 C Set lprn=.true. for debugging
5509 write (iout,'(a)') 'Contact function values:'
5511 write (iout,'(i2,20(1x,i2,f10.5))')
5512 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5527 num_conti=num_cont(i)
5528 num_conti1=num_cont(i1)
5533 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5534 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5535 cd & ' ishift=',ishift
5536 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5537 C The system gains extra energy.
5538 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5539 endif ! j1==j+-ishift
5548 c------------------------------------------------------------------------------
5549 double precision function esccorr(i,j,k,l,jj,kk)
5550 implicit real*8 (a-h,o-z)
5551 include 'DIMENSIONS'
5552 include 'COMMON.IOUNITS'
5553 include 'COMMON.DERIV'
5554 include 'COMMON.INTERACT'
5555 include 'COMMON.CONTACTS'
5556 double precision gx(3),gx1(3)
5561 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5562 C Calculate the multi-body contribution to energy.
5563 C Calculate multi-body contributions to the gradient.
5564 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5565 cd & k,l,(gacont(m,kk,k),m=1,3)
5567 gx(m) =ekl*gacont(m,jj,i)
5568 gx1(m)=eij*gacont(m,kk,k)
5569 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5570 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5571 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5572 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5576 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5581 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5587 c------------------------------------------------------------------------------
5589 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5590 implicit real*8 (a-h,o-z)
5591 include 'DIMENSIONS'
5592 integer dimen1,dimen2,atom,indx
5593 double precision buffer(dimen1,dimen2)
5594 double precision zapas
5595 common /contacts_hb/ zapas(3,maxconts,maxres,8),
5596 & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5597 & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5598 & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5599 num_kont=num_cont_hb(atom)
5603 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5606 buffer(i,indx+25)=facont_hb(i,atom)
5607 buffer(i,indx+26)=ees0p(i,atom)
5608 buffer(i,indx+27)=ees0m(i,atom)
5609 buffer(i,indx+28)=d_cont(i,atom)
5610 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
5612 buffer(1,indx+30)=dfloat(num_kont)
5615 c------------------------------------------------------------------------------
5616 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5617 implicit real*8 (a-h,o-z)
5618 include 'DIMENSIONS'
5619 integer dimen1,dimen2,atom,indx
5620 double precision buffer(dimen1,dimen2)
5621 double precision zapas
5622 common /contacts_hb/ zapas(3,maxconts,maxres,8),
5623 & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5624 & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5625 & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5626 num_kont=buffer(1,indx+30)
5627 num_kont_old=num_cont_hb(atom)
5628 num_cont_hb(atom)=num_kont+num_kont_old
5633 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5636 facont_hb(ii,atom)=buffer(i,indx+25)
5637 ees0p(ii,atom)=buffer(i,indx+26)
5638 ees0m(ii,atom)=buffer(i,indx+27)
5639 d_cont(i,atom)=buffer(i,indx+28)
5640 jcont_hb(ii,atom)=buffer(i,indx+29)
5644 c------------------------------------------------------------------------------
5646 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5647 C This subroutine calculates multi-body contributions to hydrogen-bonding
5648 implicit real*8 (a-h,o-z)
5649 include 'DIMENSIONS'
5650 include 'COMMON.IOUNITS'
5653 parameter (max_cont=maxconts)
5654 parameter (max_dim=2*(8*3+6))
5655 parameter (msglen1=max_cont*max_dim)
5656 parameter (msglen2=2*msglen1)
5657 integer source,CorrelType,CorrelID,Error
5658 double precision buffer(max_cont,max_dim)
5659 integer status(MPI_STATUS_SIZE)
5661 include 'COMMON.SETUP'
5662 include 'COMMON.FFIELD'
5663 include 'COMMON.DERIV'
5664 include 'COMMON.INTERACT'
5665 include 'COMMON.CONTACTS'
5666 include 'COMMON.CONTROL'
5667 double precision gx(3),gx1(3),time00
5670 C Set lprn=.true. for debugging
5675 if (nfgtasks.le.1) goto 30
5677 write (iout,'(a)') 'Contact function values:'
5679 write (iout,'(2i3,50(1x,i2,f5.2))')
5680 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5681 & j=1,num_cont_hb(i))
5684 C Caution! Following code assumes that electrostatic interactions concerning
5685 C a given atom are split among at most two processors!
5695 c write (*,*) 'MyRank',MyRank,' mm',mm
5698 c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5699 if (fg_rank.gt.0) then
5700 C Send correlation contributions to the preceding processor
5702 nn=num_cont_hb(iatel_s)
5703 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5704 c write (*,*) 'The BUFFER array:'
5706 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5708 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5710 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5711 C Clear the contacts of the atom passed to the neighboring processor
5712 nn=num_cont_hb(iatel_s+1)
5714 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5716 num_cont_hb(iatel_s)=0
5718 cd write (iout,*) 'Processor ',fg_rank,MyRank,
5719 cd & ' is sending correlation contribution to processor',fg_rank-1,
5720 cd & ' msglen=',msglen
5721 c write (*,*) 'Processor ',fg_rank,MyRank,
5722 c & ' is sending correlation contribution to processor',fg_rank-1,
5723 c & ' msglen=',msglen,' CorrelType=',CorrelType
5725 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5726 & CorrelType,FG_COMM,IERROR)
5727 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5728 cd write (iout,*) 'Processor ',fg_rank,
5729 cd & ' has sent correlation contribution to processor',fg_rank-1,
5730 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5731 c write (*,*) 'Processor ',fg_rank,
5732 c & ' has sent correlation contribution to processor',fg_rank-1,
5733 c & ' msglen=',msglen,' CorrelID=',CorrelID
5735 endif ! (fg_rank.gt.0)
5739 c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5740 if (fg_rank.lt.nfgtasks-1) then
5741 C Receive correlation contributions from the next processor
5743 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5744 cd write (iout,*) 'Processor',fg_rank,
5745 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5746 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5747 c write (*,*) 'Processor',fg_rank,
5748 c &' is receiving correlation contribution from processor',fg_rank+1,
5749 c & ' msglen=',msglen,' CorrelType=',CorrelType
5752 do while (nbytes.le.0)
5753 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5754 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5756 c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
5757 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5758 & fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5759 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5760 c write (*,*) 'Processor',fg_rank,
5761 c &' has received correlation contribution from processor',fg_rank+1,
5762 c & ' msglen=',msglen,' nbytes=',nbytes
5763 c write (*,*) 'The received BUFFER array:'
5765 c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
5767 if (msglen.eq.msglen1) then
5768 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5769 else if (msglen.eq.msglen2) then
5770 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5771 call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5774 & 'ERROR!!!! message length changed while processing correlations.'
5776 & 'ERROR!!!! message length changed while processing correlations.'
5777 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5778 endif ! msglen.eq.msglen1
5779 endif ! fg_rank.lt.nfgtasks-1
5786 write (iout,'(a)') 'Contact function values:'
5788 write (iout,'(2i3,50(1x,i2,f5.2))')
5789 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5790 & j=1,num_cont_hb(i))
5794 C Remove the loop below after debugging !!!
5801 C Calculate the local-electrostatic correlation terms
5802 do i=iatel_s,iatel_e+1
5804 num_conti=num_cont_hb(i)
5805 num_conti1=num_cont_hb(i+1)
5810 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5811 c & ' jj=',jj,' kk=',kk
5812 if (j1.eq.j+1 .or. j1.eq.j-1) then
5813 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5814 C The system gains extra energy.
5815 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5816 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5817 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5819 else if (j1.eq.j) then
5820 C Contacts I-J and I-(J+1) occur simultaneously.
5821 C The system loses extra energy.
5822 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5827 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5828 c & ' jj=',jj,' kk=',kk
5830 C Contacts I-J and (I+1)-J occur simultaneously.
5831 C The system loses extra energy.
5832 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5839 c------------------------------------------------------------------------------
5840 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5842 C This subroutine calculates multi-body contributions to hydrogen-bonding
5843 implicit real*8 (a-h,o-z)
5844 include 'DIMENSIONS'
5845 include 'COMMON.IOUNITS'
5848 parameter (max_cont=maxconts)
5849 parameter (max_dim=2*(8*3+6))
5850 c parameter (msglen1=max_cont*max_dim*4)
5851 parameter (msglen1=max_cont*max_dim/2)
5852 parameter (msglen2=2*msglen1)
5853 integer source,CorrelType,CorrelID,Error
5854 double precision buffer(max_cont,max_dim)
5855 integer status(MPI_STATUS_SIZE)
5857 include 'COMMON.SETUP'
5858 include 'COMMON.FFIELD'
5859 include 'COMMON.DERIV'
5860 include 'COMMON.INTERACT'
5861 include 'COMMON.CONTACTS'
5862 include 'COMMON.CONTROL'
5863 double precision gx(3),gx1(3)
5865 C Set lprn=.true. for debugging
5871 if (fgProcs.le.1) goto 30
5873 write (iout,'(a)') 'Contact function values:'
5875 write (iout,'(2i3,50(1x,i2,f5.2))')
5876 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5877 & j=1,num_cont_hb(i))
5880 C Caution! Following code assumes that electrostatic interactions concerning
5881 C a given atom are split among at most two processors!
5891 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5894 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5895 if (MyRank.gt.0) then
5896 C Send correlation contributions to the preceding processor
5898 nn=num_cont_hb(iatel_s)
5899 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5900 cd write (iout,*) 'The BUFFER array:'
5902 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5904 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5906 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5907 C Clear the contacts of the atom passed to the neighboring processor
5908 nn=num_cont_hb(iatel_s+1)
5910 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5912 num_cont_hb(iatel_s)=0
5914 cd write (*,*) 'Processor ',fg_rank,MyRank,
5915 cd & ' is sending correlation contribution to processor',fg_rank-1,
5916 cd & ' msglen=',msglen
5917 cd write (*,*) 'Processor ',MyID,MyRank,
5918 cd & ' is sending correlation contribution to processor',fg_rank-1,
5919 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5921 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5922 & CorrelType,FG_COMM,IERROR)
5923 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5924 cd write (*,*) 'Processor ',fg_rank,MyRank,
5925 cd & ' has sent correlation contribution to processor',fg_rank-1,
5926 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5927 cd write (*,*) 'Processor ',fg_rank,
5928 cd & ' has sent correlation contribution to processor',fg_rank-1,
5929 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5931 endif ! (MyRank.gt.0)
5935 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5936 if (fg_rank.lt.nfgtasks-1) then
5937 C Receive correlation contributions from the next processor
5939 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5940 cd write (iout,*) 'Processor',fg_rank,
5941 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5942 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5943 cd write (*,*) 'Processor',fg_rank,
5944 cd & ' is receiving correlation contribution from processor',fg_rank+1,
5945 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5948 do while (nbytes.le.0)
5949 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5950 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5952 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5953 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5954 & fg_rank+1,CorrelType,status,IERROR)
5955 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5956 cd write (iout,*) 'Processor',fg_rank,
5957 cd & ' has received correlation contribution from processor',fg_rank+1,
5958 cd & ' msglen=',msglen,' nbytes=',nbytes
5959 cd write (iout,*) 'The received BUFFER array:'
5961 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5963 if (msglen.eq.msglen1) then
5964 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5965 else if (msglen.eq.msglen2) then
5966 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5967 call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5970 & 'ERROR!!!! message length changed while processing correlations.'
5972 & 'ERROR!!!! message length changed while processing correlations.'
5973 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5974 endif ! msglen.eq.msglen1
5975 endif ! fg_rank.lt.nfgtasks-1
5982 write (iout,'(a)') 'Contact function values:'
5984 write (iout,'(2i3,50(1x,i2,f5.2))')
5985 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5986 & j=1,num_cont_hb(i))
5992 C Remove the loop below after debugging !!!
5999 C Calculate the dipole-dipole interaction energies
6000 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6001 do i=iatel_s,iatel_e+1
6002 num_conti=num_cont_hb(i)
6011 C Calculate the local-electrostatic correlation terms
6012 do i=iatel_s,iatel_e+1
6014 num_conti=num_cont_hb(i)
6015 num_conti1=num_cont_hb(i+1)
6020 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6021 c & ' jj=',jj,' kk=',kk
6022 if (j1.eq.j+1 .or. j1.eq.j-1) then
6023 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6024 C The system gains extra energy.
6026 sqd1=dsqrt(d_cont(jj,i))
6027 sqd2=dsqrt(d_cont(kk,i1))
6028 sred_geom = sqd1*sqd2
6029 IF (sred_geom.lt.cutoff_corr) THEN
6030 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6032 cd write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6033 cd & ' jj=',jj,' kk=',kk
6034 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6035 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6037 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6038 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6041 cd write (iout,*) 'sred_geom=',sred_geom,
6042 cd & ' ekont=',ekont,' fprim=',fprimcont
6043 call calc_eello(i,j,i+1,j1,jj,kk)
6044 if (wcorr4.gt.0.0d0)
6045 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6046 if (energy_dec.and.wcorr4.gt.0.0d0)
6047 1 write (iout,'(a6,2i5,0pf7.3)')
6048 2 'ecorr4',i,j,eello4(i,j,i+1,j1,jj,kk)
6049 if (wcorr5.gt.0.0d0)
6050 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6051 if (energy_dec.and.wcorr5.gt.0.0d0)
6052 1 write (iout,'(a6,2i5,0pf7.3)')
6053 2 'ecorr5',i,j,eello5(i,j,i+1,j1,jj,kk)
6054 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6055 cd write(2,*)'ijkl',i,j,i+1,j1
6056 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6057 & .or. wturn6.eq.0.0d0))then
6058 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6059 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6060 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6061 1 'ecorr6',i,j,eello6(i,j,i+1,j1,jj,kk)
6062 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6063 cd & 'ecorr6=',ecorr6
6064 cd write (iout,'(4e15.5)') sred_geom,
6065 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6066 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6067 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6068 else if (wturn6.gt.0.0d0
6069 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6070 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6071 eturn6=eturn6+eello_turn6(i,jj,kk)
6072 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6073 1 'eturn6',i,j,eello_turn6(i,jj,kk)
6074 cd write (2,*) 'multibody_eello:eturn6',eturn6
6078 else if (j1.eq.j) then
6079 C Contacts I-J and I-(J+1) occur simultaneously.
6080 C The system loses extra energy.
6081 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6086 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6087 c & ' jj=',jj,' kk=',kk
6089 C Contacts I-J and (I+1)-J occur simultaneously.
6090 C The system loses extra energy.
6091 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6098 c------------------------------------------------------------------------------
6099 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6100 implicit real*8 (a-h,o-z)
6101 include 'DIMENSIONS'
6102 include 'COMMON.IOUNITS'
6103 include 'COMMON.DERIV'
6104 include 'COMMON.INTERACT'
6105 include 'COMMON.CONTACTS'
6106 double precision gx(3),gx1(3)
6116 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6117 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6118 C Following 4 lines for diagnostics.
6123 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6125 c write (iout,*)'Contacts have occurred for peptide groups',
6126 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6127 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6128 C Calculate the multi-body contribution to energy.
6129 ecorr=ecorr+ekont*ees
6130 C Calculate multi-body contributions to the gradient.
6132 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6133 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6134 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6135 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6136 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6137 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6138 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6139 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6140 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6141 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6142 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6143 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6144 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6145 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6149 gradcorr(ll,m)=gradcorr(ll,m)+
6150 & ees*ekl*gacont_hbr(ll,jj,i)-
6151 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6152 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6157 gradcorr(ll,m)=gradcorr(ll,m)+
6158 & ees*eij*gacont_hbr(ll,kk,k)-
6159 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6160 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6167 C---------------------------------------------------------------------------
6168 subroutine dipole(i,j,jj)
6169 implicit real*8 (a-h,o-z)
6170 include 'DIMENSIONS'
6171 include 'COMMON.IOUNITS'
6172 include 'COMMON.CHAIN'
6173 include 'COMMON.FFIELD'
6174 include 'COMMON.DERIV'
6175 include 'COMMON.INTERACT'
6176 include 'COMMON.CONTACTS'
6177 include 'COMMON.TORSION'
6178 include 'COMMON.VAR'
6179 include 'COMMON.GEO'
6180 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6182 iti1 = itortyp(itype(i+1))
6183 if (j.lt.nres-1) then
6184 itj1 = itortyp(itype(j+1))
6189 dipi(iii,1)=Ub2(iii,i)
6190 dipderi(iii)=Ub2der(iii,i)
6191 dipi(iii,2)=b1(iii,iti1)
6192 dipj(iii,1)=Ub2(iii,j)
6193 dipderj(iii)=Ub2der(iii,j)
6194 dipj(iii,2)=b1(iii,itj1)
6198 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6201 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6208 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6212 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6217 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6218 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6220 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6222 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6224 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6229 C---------------------------------------------------------------------------
6230 subroutine calc_eello(i,j,k,l,jj,kk)
6232 C This subroutine computes matrices and vectors needed to calculate
6233 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6235 implicit real*8 (a-h,o-z)
6236 include 'DIMENSIONS'
6237 include 'COMMON.IOUNITS'
6238 include 'COMMON.CHAIN'
6239 include 'COMMON.DERIV'
6240 include 'COMMON.INTERACT'
6241 include 'COMMON.CONTACTS'
6242 include 'COMMON.TORSION'
6243 include 'COMMON.VAR'
6244 include 'COMMON.GEO'
6245 include 'COMMON.FFIELD'
6246 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6247 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6250 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6251 cd & ' jj=',jj,' kk=',kk
6252 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6255 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6256 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6259 call transpose2(aa1(1,1),aa1t(1,1))
6260 call transpose2(aa2(1,1),aa2t(1,1))
6263 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6264 & aa1tder(1,1,lll,kkk))
6265 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6266 & aa2tder(1,1,lll,kkk))
6270 C parallel orientation of the two CA-CA-CA frames.
6272 iti=itortyp(itype(i))
6276 itk1=itortyp(itype(k+1))
6277 itj=itortyp(itype(j))
6278 if (l.lt.nres-1) then
6279 itl1=itortyp(itype(l+1))
6283 C A1 kernel(j+1) A2T
6285 cd write (iout,'(3f10.5,5x,3f10.5)')
6286 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6288 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6289 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6290 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6291 C Following matrices are needed only for 6-th order cumulants
6292 IF (wcorr6.gt.0.0d0) THEN
6293 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6294 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6295 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6296 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6297 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6298 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6299 & ADtEAderx(1,1,1,1,1,1))
6301 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6302 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6303 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6304 & ADtEA1derx(1,1,1,1,1,1))
6306 C End 6-th order cumulants
6309 cd write (2,*) 'In calc_eello6'
6311 cd write (2,*) 'iii=',iii
6313 cd write (2,*) 'kkk=',kkk
6315 cd write (2,'(3(2f10.5),5x)')
6316 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6321 call transpose2(EUgder(1,1,k),auxmat(1,1))
6322 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6323 call transpose2(EUg(1,1,k),auxmat(1,1))
6324 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6325 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6329 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6330 & EAEAderx(1,1,lll,kkk,iii,1))
6334 C A1T kernel(i+1) A2
6335 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6336 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6337 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6338 C Following matrices are needed only for 6-th order cumulants
6339 IF (wcorr6.gt.0.0d0) THEN
6340 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6341 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6342 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6343 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6344 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6345 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6346 & ADtEAderx(1,1,1,1,1,2))
6347 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6348 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6349 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6350 & ADtEA1derx(1,1,1,1,1,2))
6352 C End 6-th order cumulants
6353 call transpose2(EUgder(1,1,l),auxmat(1,1))
6354 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6355 call transpose2(EUg(1,1,l),auxmat(1,1))
6356 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6357 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6361 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6362 & EAEAderx(1,1,lll,kkk,iii,2))
6367 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6368 C They are needed only when the fifth- or the sixth-order cumulants are
6370 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6371 call transpose2(AEA(1,1,1),auxmat(1,1))
6372 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6373 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6374 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6375 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6376 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6377 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6378 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6379 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6380 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6381 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6382 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6383 call transpose2(AEA(1,1,2),auxmat(1,1))
6384 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6385 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6386 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6387 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6388 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6389 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6390 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6391 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6392 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6393 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6394 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6395 C Calculate the Cartesian derivatives of the vectors.
6399 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6400 call matvec2(auxmat(1,1),b1(1,iti),
6401 & AEAb1derx(1,lll,kkk,iii,1,1))
6402 call matvec2(auxmat(1,1),Ub2(1,i),
6403 & AEAb2derx(1,lll,kkk,iii,1,1))
6404 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6405 & AEAb1derx(1,lll,kkk,iii,2,1))
6406 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6407 & AEAb2derx(1,lll,kkk,iii,2,1))
6408 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6409 call matvec2(auxmat(1,1),b1(1,itj),
6410 & AEAb1derx(1,lll,kkk,iii,1,2))
6411 call matvec2(auxmat(1,1),Ub2(1,j),
6412 & AEAb2derx(1,lll,kkk,iii,1,2))
6413 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6414 & AEAb1derx(1,lll,kkk,iii,2,2))
6415 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6416 & AEAb2derx(1,lll,kkk,iii,2,2))
6423 C Antiparallel orientation of the two CA-CA-CA frames.
6425 iti=itortyp(itype(i))
6429 itk1=itortyp(itype(k+1))
6430 itl=itortyp(itype(l))
6431 itj=itortyp(itype(j))
6432 if (j.lt.nres-1) then
6433 itj1=itortyp(itype(j+1))
6437 C A2 kernel(j-1)T A1T
6438 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6439 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6440 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6441 C Following matrices are needed only for 6-th order cumulants
6442 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6443 & j.eq.i+4 .and. l.eq.i+3)) THEN
6444 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6445 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6446 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6447 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6448 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6449 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6450 & ADtEAderx(1,1,1,1,1,1))
6451 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6452 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6453 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6454 & ADtEA1derx(1,1,1,1,1,1))
6456 C End 6-th order cumulants
6457 call transpose2(EUgder(1,1,k),auxmat(1,1))
6458 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6459 call transpose2(EUg(1,1,k),auxmat(1,1))
6460 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6461 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6465 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6466 & EAEAderx(1,1,lll,kkk,iii,1))
6470 C A2T kernel(i+1)T A1
6471 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6472 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6473 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6474 C Following matrices are needed only for 6-th order cumulants
6475 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6476 & j.eq.i+4 .and. l.eq.i+3)) THEN
6477 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6478 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6479 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6480 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6481 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6482 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6483 & ADtEAderx(1,1,1,1,1,2))
6484 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6485 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6486 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6487 & ADtEA1derx(1,1,1,1,1,2))
6489 C End 6-th order cumulants
6490 call transpose2(EUgder(1,1,j),auxmat(1,1))
6491 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6492 call transpose2(EUg(1,1,j),auxmat(1,1))
6493 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6494 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6498 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6499 & EAEAderx(1,1,lll,kkk,iii,2))
6504 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6505 C They are needed only when the fifth- or the sixth-order cumulants are
6507 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6508 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6509 call transpose2(AEA(1,1,1),auxmat(1,1))
6510 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6511 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6512 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6513 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6514 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6515 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6516 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6517 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6518 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6519 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6520 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6521 call transpose2(AEA(1,1,2),auxmat(1,1))
6522 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6523 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6524 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6525 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6526 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6527 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6528 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6529 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6530 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6531 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6532 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6533 C Calculate the Cartesian derivatives of the vectors.
6537 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6538 call matvec2(auxmat(1,1),b1(1,iti),
6539 & AEAb1derx(1,lll,kkk,iii,1,1))
6540 call matvec2(auxmat(1,1),Ub2(1,i),
6541 & AEAb2derx(1,lll,kkk,iii,1,1))
6542 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6543 & AEAb1derx(1,lll,kkk,iii,2,1))
6544 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6545 & AEAb2derx(1,lll,kkk,iii,2,1))
6546 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6547 call matvec2(auxmat(1,1),b1(1,itl),
6548 & AEAb1derx(1,lll,kkk,iii,1,2))
6549 call matvec2(auxmat(1,1),Ub2(1,l),
6550 & AEAb2derx(1,lll,kkk,iii,1,2))
6551 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6552 & AEAb1derx(1,lll,kkk,iii,2,2))
6553 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6554 & AEAb2derx(1,lll,kkk,iii,2,2))
6563 C---------------------------------------------------------------------------
6564 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6565 & KK,KKderg,AKA,AKAderg,AKAderx)
6569 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6570 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6571 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6576 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6578 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6581 cd if (lprn) write (2,*) 'In kernel'
6583 cd if (lprn) write (2,*) 'kkk=',kkk
6585 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6586 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6588 cd write (2,*) 'lll=',lll
6589 cd write (2,*) 'iii=1'
6591 cd write (2,'(3(2f10.5),5x)')
6592 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6595 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6596 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6598 cd write (2,*) 'lll=',lll
6599 cd write (2,*) 'iii=2'
6601 cd write (2,'(3(2f10.5),5x)')
6602 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6609 C---------------------------------------------------------------------------
6610 double precision function eello4(i,j,k,l,jj,kk)
6611 implicit real*8 (a-h,o-z)
6612 include 'DIMENSIONS'
6613 include 'COMMON.IOUNITS'
6614 include 'COMMON.CHAIN'
6615 include 'COMMON.DERIV'
6616 include 'COMMON.INTERACT'
6617 include 'COMMON.CONTACTS'
6618 include 'COMMON.TORSION'
6619 include 'COMMON.VAR'
6620 include 'COMMON.GEO'
6621 double precision pizda(2,2),ggg1(3),ggg2(3)
6622 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6626 cd print *,'eello4:',i,j,k,l,jj,kk
6627 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6628 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6629 cold eij=facont_hb(jj,i)
6630 cold ekl=facont_hb(kk,k)
6632 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6633 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6634 gcorr_loc(k-1)=gcorr_loc(k-1)
6635 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6637 gcorr_loc(l-1)=gcorr_loc(l-1)
6638 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6640 gcorr_loc(j-1)=gcorr_loc(j-1)
6641 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6646 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6647 & -EAEAderx(2,2,lll,kkk,iii,1)
6648 cd derx(lll,kkk,iii)=0.0d0
6652 cd gcorr_loc(l-1)=0.0d0
6653 cd gcorr_loc(j-1)=0.0d0
6654 cd gcorr_loc(k-1)=0.0d0
6656 cd write (iout,*)'Contacts have occurred for peptide groups',
6657 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6658 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6659 if (j.lt.nres-1) then
6666 if (l.lt.nres-1) then
6674 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6675 ggg1(ll)=eel4*g_contij(ll,1)
6676 ggg2(ll)=eel4*g_contij(ll,2)
6677 ghalf=0.5d0*ggg1(ll)
6679 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6680 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6681 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6682 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6683 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6684 ghalf=0.5d0*ggg2(ll)
6686 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6687 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6688 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6689 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6694 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6695 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6700 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6701 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6707 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6712 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6716 cd write (2,*) iii,gcorr_loc(iii)
6719 cd write (2,*) 'ekont',ekont
6720 cd write (iout,*) 'eello4',ekont*eel4
6723 C---------------------------------------------------------------------------
6724 double precision function eello5(i,j,k,l,jj,kk)
6725 implicit real*8 (a-h,o-z)
6726 include 'DIMENSIONS'
6727 include 'COMMON.IOUNITS'
6728 include 'COMMON.CHAIN'
6729 include 'COMMON.DERIV'
6730 include 'COMMON.INTERACT'
6731 include 'COMMON.CONTACTS'
6732 include 'COMMON.TORSION'
6733 include 'COMMON.VAR'
6734 include 'COMMON.GEO'
6735 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6736 double precision ggg1(3),ggg2(3)
6737 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6742 C /l\ / \ \ / \ / \ / C
6743 C / \ / \ \ / \ / \ / C
6744 C j| o |l1 | o | o| o | | o |o C
6745 C \ |/k\| |/ \| / |/ \| |/ \| C
6746 C \i/ \ / \ / / \ / \ C
6748 C (I) (II) (III) (IV) C
6750 C eello5_1 eello5_2 eello5_3 eello5_4 C
6752 C Antiparallel chains C
6755 C /j\ / \ \ / \ / \ / C
6756 C / \ / \ \ / \ / \ / C
6757 C j1| o |l | o | o| o | | o |o C
6758 C \ |/k\| |/ \| / |/ \| |/ \| C
6759 C \i/ \ / \ / / \ / \ C
6761 C (I) (II) (III) (IV) C
6763 C eello5_1 eello5_2 eello5_3 eello5_4 C
6765 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6767 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6768 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6773 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6775 itk=itortyp(itype(k))
6776 itl=itortyp(itype(l))
6777 itj=itortyp(itype(j))
6782 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6783 cd & eel5_3_num,eel5_4_num)
6787 derx(lll,kkk,iii)=0.0d0
6791 cd eij=facont_hb(jj,i)
6792 cd ekl=facont_hb(kk,k)
6794 cd write (iout,*)'Contacts have occurred for peptide groups',
6795 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6797 C Contribution from the graph I.
6798 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6799 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6800 call transpose2(EUg(1,1,k),auxmat(1,1))
6801 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6802 vv(1)=pizda(1,1)-pizda(2,2)
6803 vv(2)=pizda(1,2)+pizda(2,1)
6804 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6805 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6806 C Explicit gradient in virtual-dihedral angles.
6807 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6808 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6809 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6810 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6811 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6812 vv(1)=pizda(1,1)-pizda(2,2)
6813 vv(2)=pizda(1,2)+pizda(2,1)
6814 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6815 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6816 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6817 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6818 vv(1)=pizda(1,1)-pizda(2,2)
6819 vv(2)=pizda(1,2)+pizda(2,1)
6821 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6822 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6823 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6825 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6826 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6827 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6829 C Cartesian gradient
6833 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6835 vv(1)=pizda(1,1)-pizda(2,2)
6836 vv(2)=pizda(1,2)+pizda(2,1)
6837 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6838 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6839 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6845 C Contribution from graph II
6846 call transpose2(EE(1,1,itk),auxmat(1,1))
6847 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6848 vv(1)=pizda(1,1)+pizda(2,2)
6849 vv(2)=pizda(2,1)-pizda(1,2)
6850 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6851 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6852 C Explicit gradient in virtual-dihedral angles.
6853 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6854 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6855 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6856 vv(1)=pizda(1,1)+pizda(2,2)
6857 vv(2)=pizda(2,1)-pizda(1,2)
6859 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6860 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6861 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6863 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6864 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6865 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6867 C Cartesian gradient
6871 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6873 vv(1)=pizda(1,1)+pizda(2,2)
6874 vv(2)=pizda(2,1)-pizda(1,2)
6875 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6876 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6877 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6885 C Parallel orientation
6886 C Contribution from graph III
6887 call transpose2(EUg(1,1,l),auxmat(1,1))
6888 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6889 vv(1)=pizda(1,1)-pizda(2,2)
6890 vv(2)=pizda(1,2)+pizda(2,1)
6891 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6892 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6893 C Explicit gradient in virtual-dihedral angles.
6894 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6895 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6896 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6897 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6898 vv(1)=pizda(1,1)-pizda(2,2)
6899 vv(2)=pizda(1,2)+pizda(2,1)
6900 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6901 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6902 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6903 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6904 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6905 vv(1)=pizda(1,1)-pizda(2,2)
6906 vv(2)=pizda(1,2)+pizda(2,1)
6907 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6908 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6909 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6910 C Cartesian gradient
6914 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6916 vv(1)=pizda(1,1)-pizda(2,2)
6917 vv(2)=pizda(1,2)+pizda(2,1)
6918 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6919 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6920 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6925 C Contribution from graph IV
6927 call transpose2(EE(1,1,itl),auxmat(1,1))
6928 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6929 vv(1)=pizda(1,1)+pizda(2,2)
6930 vv(2)=pizda(2,1)-pizda(1,2)
6931 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6932 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6933 C Explicit gradient in virtual-dihedral angles.
6934 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6935 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6936 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6937 vv(1)=pizda(1,1)+pizda(2,2)
6938 vv(2)=pizda(2,1)-pizda(1,2)
6939 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6940 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6941 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6942 C Cartesian gradient
6946 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6948 vv(1)=pizda(1,1)+pizda(2,2)
6949 vv(2)=pizda(2,1)-pizda(1,2)
6950 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6951 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6952 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6957 C Antiparallel orientation
6958 C Contribution from graph III
6960 call transpose2(EUg(1,1,j),auxmat(1,1))
6961 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6962 vv(1)=pizda(1,1)-pizda(2,2)
6963 vv(2)=pizda(1,2)+pizda(2,1)
6964 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6965 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6966 C Explicit gradient in virtual-dihedral angles.
6967 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6968 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6969 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6970 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6971 vv(1)=pizda(1,1)-pizda(2,2)
6972 vv(2)=pizda(1,2)+pizda(2,1)
6973 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6974 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6975 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6976 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6977 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6978 vv(1)=pizda(1,1)-pizda(2,2)
6979 vv(2)=pizda(1,2)+pizda(2,1)
6980 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6981 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6982 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6983 C Cartesian gradient
6987 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6989 vv(1)=pizda(1,1)-pizda(2,2)
6990 vv(2)=pizda(1,2)+pizda(2,1)
6991 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6992 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6993 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6998 C Contribution from graph IV
7000 call transpose2(EE(1,1,itj),auxmat(1,1))
7001 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7002 vv(1)=pizda(1,1)+pizda(2,2)
7003 vv(2)=pizda(2,1)-pizda(1,2)
7004 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7005 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7006 C Explicit gradient in virtual-dihedral angles.
7007 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7008 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7009 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7010 vv(1)=pizda(1,1)+pizda(2,2)
7011 vv(2)=pizda(2,1)-pizda(1,2)
7012 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7013 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7014 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7015 C Cartesian gradient
7019 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7021 vv(1)=pizda(1,1)+pizda(2,2)
7022 vv(2)=pizda(2,1)-pizda(1,2)
7023 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7024 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7025 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7031 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7032 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7033 cd write (2,*) 'ijkl',i,j,k,l
7034 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7035 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7037 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7038 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7039 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7040 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7041 if (j.lt.nres-1) then
7048 if (l.lt.nres-1) then
7058 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7060 ggg1(ll)=eel5*g_contij(ll,1)
7061 ggg2(ll)=eel5*g_contij(ll,2)
7062 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7063 ghalf=0.5d0*ggg1(ll)
7065 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7066 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7067 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7068 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7069 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7070 ghalf=0.5d0*ggg2(ll)
7072 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7073 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7074 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7075 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7080 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7081 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7086 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7087 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7093 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7098 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7102 cd write (2,*) iii,g_corr5_loc(iii)
7105 cd write (2,*) 'ekont',ekont
7106 cd write (iout,*) 'eello5',ekont*eel5
7109 c--------------------------------------------------------------------------
7110 double precision function eello6(i,j,k,l,jj,kk)
7111 implicit real*8 (a-h,o-z)
7112 include 'DIMENSIONS'
7113 include 'COMMON.IOUNITS'
7114 include 'COMMON.CHAIN'
7115 include 'COMMON.DERIV'
7116 include 'COMMON.INTERACT'
7117 include 'COMMON.CONTACTS'
7118 include 'COMMON.TORSION'
7119 include 'COMMON.VAR'
7120 include 'COMMON.GEO'
7121 include 'COMMON.FFIELD'
7122 double precision ggg1(3),ggg2(3)
7123 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7128 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7136 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7137 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7141 derx(lll,kkk,iii)=0.0d0
7145 cd eij=facont_hb(jj,i)
7146 cd ekl=facont_hb(kk,k)
7152 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7153 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7154 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7155 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7156 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7157 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7159 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7160 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7161 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7162 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7163 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7164 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7168 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7170 C If turn contributions are considered, they will be handled separately.
7171 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7172 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7173 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7174 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7175 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7176 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7177 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7179 if (j.lt.nres-1) then
7186 if (l.lt.nres-1) then
7194 ggg1(ll)=eel6*g_contij(ll,1)
7195 ggg2(ll)=eel6*g_contij(ll,2)
7196 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7197 ghalf=0.5d0*ggg1(ll)
7199 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7200 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7201 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7202 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7203 ghalf=0.5d0*ggg2(ll)
7204 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7206 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7207 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7208 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7209 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7214 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7215 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7220 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7221 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7227 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7232 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7236 cd write (2,*) iii,g_corr6_loc(iii)
7239 cd write (2,*) 'ekont',ekont
7240 cd write (iout,*) 'eello6',ekont*eel6
7243 c--------------------------------------------------------------------------
7244 double precision function eello6_graph1(i,j,k,l,imat,swap)
7245 implicit real*8 (a-h,o-z)
7246 include 'DIMENSIONS'
7247 include 'COMMON.IOUNITS'
7248 include 'COMMON.CHAIN'
7249 include 'COMMON.DERIV'
7250 include 'COMMON.INTERACT'
7251 include 'COMMON.CONTACTS'
7252 include 'COMMON.TORSION'
7253 include 'COMMON.VAR'
7254 include 'COMMON.GEO'
7255 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7259 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7261 C Parallel Antiparallel
7267 C \ j|/k\| / \ |/k\|l /
7272 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7273 itk=itortyp(itype(k))
7274 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7275 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7276 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7277 call transpose2(EUgC(1,1,k),auxmat(1,1))
7278 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7279 vv1(1)=pizda1(1,1)-pizda1(2,2)
7280 vv1(2)=pizda1(1,2)+pizda1(2,1)
7281 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7282 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7283 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7284 s5=scalar2(vv(1),Dtobr2(1,i))
7285 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7286 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7287 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7288 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7289 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7290 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7291 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7292 & +scalar2(vv(1),Dtobr2der(1,i)))
7293 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7294 vv1(1)=pizda1(1,1)-pizda1(2,2)
7295 vv1(2)=pizda1(1,2)+pizda1(2,1)
7296 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7297 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7299 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7300 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7301 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7302 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7303 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7305 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7306 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7307 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7308 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7309 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7311 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7312 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7313 vv1(1)=pizda1(1,1)-pizda1(2,2)
7314 vv1(2)=pizda1(1,2)+pizda1(2,1)
7315 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7316 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7317 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7318 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7327 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7328 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7329 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7330 call transpose2(EUgC(1,1,k),auxmat(1,1))
7331 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7333 vv1(1)=pizda1(1,1)-pizda1(2,2)
7334 vv1(2)=pizda1(1,2)+pizda1(2,1)
7335 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7336 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7337 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7338 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7339 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7340 s5=scalar2(vv(1),Dtobr2(1,i))
7341 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7347 c----------------------------------------------------------------------------
7348 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7349 implicit real*8 (a-h,o-z)
7350 include 'DIMENSIONS'
7351 include 'COMMON.IOUNITS'
7352 include 'COMMON.CHAIN'
7353 include 'COMMON.DERIV'
7354 include 'COMMON.INTERACT'
7355 include 'COMMON.CONTACTS'
7356 include 'COMMON.TORSION'
7357 include 'COMMON.VAR'
7358 include 'COMMON.GEO'
7360 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7361 & auxvec1(2),auxvec2(1),auxmat1(2,2)
7364 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7366 C Parallel Antiparallel
7377 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7378 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7379 C AL 7/4/01 s1 would occur in the sixth-order moment,
7380 C but not in a cluster cumulant
7382 s1=dip(1,jj,i)*dip(1,kk,k)
7384 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7385 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7386 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7387 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7388 call transpose2(EUg(1,1,k),auxmat(1,1))
7389 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7390 vv(1)=pizda(1,1)-pizda(2,2)
7391 vv(2)=pizda(1,2)+pizda(2,1)
7392 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7393 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7395 eello6_graph2=-(s1+s2+s3+s4)
7397 eello6_graph2=-(s2+s3+s4)
7400 C Derivatives in gamma(i-1)
7403 s1=dipderg(1,jj,i)*dip(1,kk,k)
7405 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7406 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7407 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7408 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7410 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7412 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7414 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7416 C Derivatives in gamma(k-1)
7418 s1=dip(1,jj,i)*dipderg(1,kk,k)
7420 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7421 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7422 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7423 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7424 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7425 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7426 vv(1)=pizda(1,1)-pizda(2,2)
7427 vv(2)=pizda(1,2)+pizda(2,1)
7428 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7430 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7432 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7434 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7435 C Derivatives in gamma(j-1) or gamma(l-1)
7438 s1=dipderg(3,jj,i)*dip(1,kk,k)
7440 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7441 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7442 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7443 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7444 vv(1)=pizda(1,1)-pizda(2,2)
7445 vv(2)=pizda(1,2)+pizda(2,1)
7446 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7449 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7451 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7454 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7455 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7457 C Derivatives in gamma(l-1) or gamma(j-1)
7460 s1=dip(1,jj,i)*dipderg(3,kk,k)
7462 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7463 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7464 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7465 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7466 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7467 vv(1)=pizda(1,1)-pizda(2,2)
7468 vv(2)=pizda(1,2)+pizda(2,1)
7469 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7472 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7474 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7477 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7478 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7480 C Cartesian derivatives.
7482 write (2,*) 'In eello6_graph2'
7484 write (2,*) 'iii=',iii
7486 write (2,*) 'kkk=',kkk
7488 write (2,'(3(2f10.5),5x)')
7489 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7499 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7501 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7504 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7506 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7507 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7509 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7510 call transpose2(EUg(1,1,k),auxmat(1,1))
7511 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7513 vv(1)=pizda(1,1)-pizda(2,2)
7514 vv(2)=pizda(1,2)+pizda(2,1)
7515 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7516 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7518 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7520 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7523 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7525 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7532 c----------------------------------------------------------------------------
7533 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7534 implicit real*8 (a-h,o-z)
7535 include 'DIMENSIONS'
7536 include 'COMMON.IOUNITS'
7537 include 'COMMON.CHAIN'
7538 include 'COMMON.DERIV'
7539 include 'COMMON.INTERACT'
7540 include 'COMMON.CONTACTS'
7541 include 'COMMON.TORSION'
7542 include 'COMMON.VAR'
7543 include 'COMMON.GEO'
7544 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7548 C Parallel Antiparallel
7559 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7561 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7562 C energy moment and not to the cluster cumulant.
7563 iti=itortyp(itype(i))
7564 if (j.lt.nres-1) then
7565 itj1=itortyp(itype(j+1))
7569 itk=itortyp(itype(k))
7570 itk1=itortyp(itype(k+1))
7571 if (l.lt.nres-1) then
7572 itl1=itortyp(itype(l+1))
7577 s1=dip(4,jj,i)*dip(4,kk,k)
7579 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7580 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7581 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7582 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7583 call transpose2(EE(1,1,itk),auxmat(1,1))
7584 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7585 vv(1)=pizda(1,1)+pizda(2,2)
7586 vv(2)=pizda(2,1)-pizda(1,2)
7587 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7588 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7590 eello6_graph3=-(s1+s2+s3+s4)
7592 eello6_graph3=-(s2+s3+s4)
7595 C Derivatives in gamma(k-1)
7596 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7597 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7598 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7599 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7600 C Derivatives in gamma(l-1)
7601 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7602 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7603 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7604 vv(1)=pizda(1,1)+pizda(2,2)
7605 vv(2)=pizda(2,1)-pizda(1,2)
7606 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7607 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7608 C Cartesian derivatives.
7614 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7616 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7619 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7621 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7622 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7624 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7625 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7627 vv(1)=pizda(1,1)+pizda(2,2)
7628 vv(2)=pizda(2,1)-pizda(1,2)
7629 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7631 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7633 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7636 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7638 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7640 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7646 c----------------------------------------------------------------------------
7647 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7648 implicit real*8 (a-h,o-z)
7649 include 'DIMENSIONS'
7650 include 'COMMON.IOUNITS'
7651 include 'COMMON.CHAIN'
7652 include 'COMMON.DERIV'
7653 include 'COMMON.INTERACT'
7654 include 'COMMON.CONTACTS'
7655 include 'COMMON.TORSION'
7656 include 'COMMON.VAR'
7657 include 'COMMON.GEO'
7658 include 'COMMON.FFIELD'
7659 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7660 & auxvec1(2),auxmat1(2,2)
7662 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7664 C Parallel Antiparallel
7675 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7677 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7678 C energy moment and not to the cluster cumulant.
7679 cd write (2,*) 'eello_graph4: wturn6',wturn6
7680 iti=itortyp(itype(i))
7681 itj=itortyp(itype(j))
7682 if (j.lt.nres-1) then
7683 itj1=itortyp(itype(j+1))
7687 itk=itortyp(itype(k))
7688 if (k.lt.nres-1) then
7689 itk1=itortyp(itype(k+1))
7693 itl=itortyp(itype(l))
7694 if (l.lt.nres-1) then
7695 itl1=itortyp(itype(l+1))
7699 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7700 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7701 cd & ' itl',itl,' itl1',itl1
7704 s1=dip(3,jj,i)*dip(3,kk,k)
7706 s1=dip(2,jj,j)*dip(2,kk,l)
7709 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7710 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7712 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7713 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7715 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7716 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7718 call transpose2(EUg(1,1,k),auxmat(1,1))
7719 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7720 vv(1)=pizda(1,1)-pizda(2,2)
7721 vv(2)=pizda(2,1)+pizda(1,2)
7722 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7723 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7725 eello6_graph4=-(s1+s2+s3+s4)
7727 eello6_graph4=-(s2+s3+s4)
7729 C Derivatives in gamma(i-1)
7733 s1=dipderg(2,jj,i)*dip(3,kk,k)
7735 s1=dipderg(4,jj,j)*dip(2,kk,l)
7738 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7740 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7741 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7743 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7744 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7746 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7747 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7748 cd write (2,*) 'turn6 derivatives'
7750 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7752 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7756 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7758 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7762 C Derivatives in gamma(k-1)
7765 s1=dip(3,jj,i)*dipderg(2,kk,k)
7767 s1=dip(2,jj,j)*dipderg(4,kk,l)
7770 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7771 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7773 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7774 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7776 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7777 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7779 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7780 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7781 vv(1)=pizda(1,1)-pizda(2,2)
7782 vv(2)=pizda(2,1)+pizda(1,2)
7783 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7784 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7786 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7788 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7792 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7794 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7797 C Derivatives in gamma(j-1) or gamma(l-1)
7798 if (l.eq.j+1 .and. l.gt.1) then
7799 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7800 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7801 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7802 vv(1)=pizda(1,1)-pizda(2,2)
7803 vv(2)=pizda(2,1)+pizda(1,2)
7804 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7805 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7806 else if (j.gt.1) then
7807 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7808 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7809 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7810 vv(1)=pizda(1,1)-pizda(2,2)
7811 vv(2)=pizda(2,1)+pizda(1,2)
7812 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7813 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7814 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7816 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7819 C Cartesian derivatives.
7826 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7828 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7832 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7834 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7838 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7840 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7842 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7843 & b1(1,itj1),auxvec(1))
7844 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7846 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7847 & b1(1,itl1),auxvec(1))
7848 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7850 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7852 vv(1)=pizda(1,1)-pizda(2,2)
7853 vv(2)=pizda(2,1)+pizda(1,2)
7854 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7856 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7858 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7861 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7864 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7867 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7869 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7871 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7875 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7877 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7880 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7882 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7890 c----------------------------------------------------------------------------
7891 double precision function eello_turn6(i,jj,kk)
7892 implicit real*8 (a-h,o-z)
7893 include 'DIMENSIONS'
7894 include 'COMMON.IOUNITS'
7895 include 'COMMON.CHAIN'
7896 include 'COMMON.DERIV'
7897 include 'COMMON.INTERACT'
7898 include 'COMMON.CONTACTS'
7899 include 'COMMON.TORSION'
7900 include 'COMMON.VAR'
7901 include 'COMMON.GEO'
7902 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7903 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7905 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7906 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7907 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7908 C the respective energy moment and not to the cluster cumulant.
7917 iti=itortyp(itype(i))
7918 itk=itortyp(itype(k))
7919 itk1=itortyp(itype(k+1))
7920 itl=itortyp(itype(l))
7921 itj=itortyp(itype(j))
7922 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7923 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7924 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7929 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7931 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7935 derx_turn(lll,kkk,iii)=0.0d0
7942 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7944 cd write (2,*) 'eello6_5',eello6_5
7946 call transpose2(AEA(1,1,1),auxmat(1,1))
7947 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7948 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7949 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7951 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7952 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7953 s2 = scalar2(b1(1,itk),vtemp1(1))
7955 call transpose2(AEA(1,1,2),atemp(1,1))
7956 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7957 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7958 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7960 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7961 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7962 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7964 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7965 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7966 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7967 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7968 ss13 = scalar2(b1(1,itk),vtemp4(1))
7969 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7971 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7977 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7978 C Derivatives in gamma(i+2)
7982 call transpose2(AEA(1,1,1),auxmatd(1,1))
7983 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7984 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7985 call transpose2(AEAderg(1,1,2),atempd(1,1))
7986 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7987 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7989 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7990 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7991 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7997 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7998 C Derivatives in gamma(i+3)
8000 call transpose2(AEA(1,1,1),auxmatd(1,1))
8001 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8002 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8003 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8005 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8006 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8007 s2d = scalar2(b1(1,itk),vtemp1d(1))
8009 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8010 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8012 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8014 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8015 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8016 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8024 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8025 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8027 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8028 & -0.5d0*ekont*(s2d+s12d)
8030 C Derivatives in gamma(i+4)
8031 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8032 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8033 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8035 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8036 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8037 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8045 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8047 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8049 C Derivatives in gamma(i+5)
8051 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8052 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8053 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8055 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8056 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8057 s2d = scalar2(b1(1,itk),vtemp1d(1))
8059 call transpose2(AEA(1,1,2),atempd(1,1))
8060 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8061 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8063 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8064 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8066 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8067 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8068 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8076 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8077 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8079 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8080 & -0.5d0*ekont*(s2d+s12d)
8082 C Cartesian derivatives
8087 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8088 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8089 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8091 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8092 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8094 s2d = scalar2(b1(1,itk),vtemp1d(1))
8096 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8097 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8098 s8d = -(atempd(1,1)+atempd(2,2))*
8099 & scalar2(cc(1,1,itl),vtemp2(1))
8101 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8103 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8104 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8111 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8114 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8118 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8119 & - 0.5d0*(s8d+s12d)
8121 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8130 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8132 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8133 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8134 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8135 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8136 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8138 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8139 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8140 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8144 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8145 cd & 16*eel_turn6_num
8147 if (j.lt.nres-1) then
8154 if (l.lt.nres-1) then
8162 ggg1(ll)=eel_turn6*g_contij(ll,1)
8163 ggg2(ll)=eel_turn6*g_contij(ll,2)
8164 ghalf=0.5d0*ggg1(ll)
8166 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8167 & +ekont*derx_turn(ll,2,1)
8168 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8169 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8170 & +ekont*derx_turn(ll,4,1)
8171 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8172 ghalf=0.5d0*ggg2(ll)
8174 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8175 & +ekont*derx_turn(ll,2,2)
8176 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8177 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8178 & +ekont*derx_turn(ll,4,2)
8179 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8184 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8189 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8195 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8200 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8204 cd write (2,*) iii,g_corr6_loc(iii)
8206 eello_turn6=ekont*eel_turn6
8207 cd write (2,*) 'ekont',ekont
8208 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8212 C-----------------------------------------------------------------------------
8213 double precision function scalar(u,v)
8214 !DIR$ INLINEALWAYS scalar
8216 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8219 double precision u(3),v(3)
8220 cd double precision sc
8228 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8231 crc-------------------------------------------------
8232 SUBROUTINE MATVEC2(A1,V1,V2)
8233 !DIR$ INLINEALWAYS MATVEC2
8235 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8237 implicit real*8 (a-h,o-z)
8238 include 'DIMENSIONS'
8239 DIMENSION A1(2,2),V1(2),V2(2)
8243 c 3 VI=VI+A1(I,K)*V1(K)
8247 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8248 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8253 C---------------------------------------
8254 SUBROUTINE MATMAT2(A1,A2,A3)
8256 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8258 implicit real*8 (a-h,o-z)
8259 include 'DIMENSIONS'
8260 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8261 c DIMENSION AI3(2,2)
8265 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8271 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8272 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8273 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8274 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8282 c-------------------------------------------------------------------------
8283 double precision function scalar2(u,v)
8284 !DIR$ INLINEALWAYS scalar2
8286 double precision u(2),v(2)
8289 scalar2=u(1)*v(1)+u(2)*v(2)
8293 C-----------------------------------------------------------------------------
8295 subroutine transpose2(a,at)
8296 !DIR$ INLINEALWAYS transpose2
8298 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8301 double precision a(2,2),at(2,2)
8308 c--------------------------------------------------------------------------
8309 subroutine transpose(n,a,at)
8312 double precision a(n,n),at(n,n)
8320 C---------------------------------------------------------------------------
8321 subroutine prodmat3(a1,a2,kk,transp,prod)
8322 !DIR$ INLINEALWAYS prodmat3
8324 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8328 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8330 crc double precision auxmat(2,2),prod_(2,2)
8333 crc call transpose2(kk(1,1),auxmat(1,1))
8334 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8335 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8337 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8338 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8339 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8340 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8341 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8342 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8343 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8344 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8347 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8348 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8350 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8351 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8352 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8353 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8354 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8355 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8356 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8357 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8360 c call transpose2(a2(1,1),a2t(1,1))
8363 crc print *,((prod_(i,j),i=1,2),j=1,2)
8364 crc print *,((prod(i,j),i=1,2),j=1,2)