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.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
86 time_Bcast=time_Bcast+MPI_Wtime()-time00
87 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
88 c call chainbuild_cart
90 c print *,'Processor',myrank,' calling etotal ipot=',ipot
91 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
93 c if (modecalc.eq.12.or.modecalc.eq.14) then
94 c call int_from_cart1(.false.)
101 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
105 101 call elj(evdw,evdw_p,evdw_m)
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
109 102 call eljk(evdw,evdw_p,evdw_m)
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 103 call ebp(evdw,evdw_p,evdw_m)
114 C Gay-Berne potential (shifted LJ, angular dependence).
115 104 call egb(evdw,evdw_p,evdw_m)
117 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 105 call egbv(evdw,evdw_p,evdw_m)
120 C Soft-sphere potential
121 106 call e_softsphere(evdw)
123 C Calculate electrostatic (H-bonding) energy of the main chain.
126 c print *,"Processor",myrank," computed USCSC"
132 time_vec=time_vec+MPI_Wtime()-time01
134 c print *,"Processor",myrank," left VEC_AND_DERIV"
137 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
138 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
139 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
140 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
142 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
143 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
144 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
145 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
147 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
156 c write (iout,*) "Soft-spheer ELEC potential"
157 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
160 c print *,"Processor",myrank," computed UELEC"
162 C Calculate excluded-volume interaction energy between peptide groups
167 call escp(evdw2,evdw2_14)
173 c write (iout,*) "Soft-sphere SCP potential"
174 call escp_soft_sphere(evdw2,evdw2_14)
177 c Calculate the bond-stretching energy
181 C Calculate the disulfide-bridge and other energy and the contributions
182 C from other distance constraints.
183 cd print *,'Calling EHPB'
185 cd print *,'EHPB exitted succesfully.'
187 C Calculate the virtual-bond-angle energy.
189 if (wang.gt.0d0) then
194 c print *,"Processor",myrank," computed UB"
196 C Calculate the SC local energy.
199 c print *,"Processor",myrank," computed USC"
201 C Calculate the virtual-bond torsional energy.
203 cd print *,'nterm=',nterm
205 call etor(etors,edihcnstr)
210 c print *,"Processor",myrank," computed Utor"
212 C 6/23/01 Calculate double-torsional energy
214 if (wtor_d.gt.0) then
219 c print *,"Processor",myrank," computed Utord"
221 C 21/5/07 Calculate local sicdechain correlation energy
223 if (wsccor.gt.0.0d0) then
224 call eback_sc_corr(esccor)
228 c print *,"Processor",myrank," computed Usccorr"
230 C 12/1/95 Multi-body terms
234 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
235 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
236 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
237 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
238 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
245 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
246 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
247 cd write (iout,*) "multibody_hb ecorr",ecorr
249 c print *,"Processor",myrank," computed Ucorr"
251 C If performing constraint dynamics, call the constraint energy
252 C after the equilibration time
253 if(usampl.and.totT.gt.eq_time) then
261 time_enecalc=time_enecalc+MPI_Wtime()-time00
263 c print *,"Processor",myrank," computed Uconstr"
272 energia(2)=evdw2-evdw2_14
289 energia(8)=eello_turn3
290 energia(9)=eello_turn4
297 energia(19)=edihcnstr
299 energia(20)=Uconst+Uconst_back
303 c print *," Processor",myrank," calls SUM_ENERGY"
304 call sum_energy(energia,.true.)
305 c print *," Processor",myrank," left SUM_ENERGY"
307 time_sumene=time_sumene+MPI_Wtime()-time00
311 c-------------------------------------------------------------------------------
312 subroutine sum_energy(energia,reduce)
313 implicit real*8 (a-h,o-z)
318 cMS$ATTRIBUTES C :: proc_proc
324 include 'COMMON.SETUP'
325 include 'COMMON.IOUNITS'
326 double precision energia(0:n_ene),enebuff(0:n_ene+1)
327 include 'COMMON.FFIELD'
328 include 'COMMON.DERIV'
329 include 'COMMON.INTERACT'
330 include 'COMMON.SBRIDGE'
331 include 'COMMON.CHAIN'
333 include 'COMMON.CONTROL'
334 include 'COMMON.TIME1'
337 if (nfgtasks.gt.1 .and. reduce) then
339 write (iout,*) "energies before REDUCE"
340 call enerprint(energia)
344 enebuff(i)=energia(i)
347 call MPI_Barrier(FG_COMM,IERR)
348 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
350 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
351 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
353 write (iout,*) "energies after REDUCE"
354 call enerprint(energia)
357 time_Reduce=time_Reduce+MPI_Wtime()-time00
359 if (fg_rank.eq.0) then
362 evdw=energia(22)+wsct*energia(23)
367 evdw2=energia(2)+energia(18)
383 eello_turn3=energia(8)
384 eello_turn4=energia(9)
391 edihcnstr=energia(19)
396 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
397 & +wang*ebe+wtor*etors+wscloc*escloc
398 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
399 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
400 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
401 & +wbond*estr+Uconst+wsccor*esccor
403 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
404 & +wang*ebe+wtor*etors+wscloc*escloc
405 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
406 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
407 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
408 & +wbond*estr+Uconst+wsccor*esccor
414 if (isnan(etot).ne.0) energia(0)=1.0d+99
416 if (isnan(etot)) energia(0)=1.0d+99
421 idumm=proc_proc(etot,i)
423 call proc_proc(etot,i)
425 if(i.eq.1)energia(0)=1.0d+99
432 c-------------------------------------------------------------------------------
433 subroutine sum_gradient
434 implicit real*8 (a-h,o-z)
439 cMS$ATTRIBUTES C :: proc_proc
444 double precision gradbufc(3,maxres),gradbufx(3,maxres),
445 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
447 double precision gradbufc(3,maxres),gradbufx(3,maxres),
448 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
450 include 'COMMON.SETUP'
451 include 'COMMON.IOUNITS'
452 include 'COMMON.FFIELD'
453 include 'COMMON.DERIV'
454 include 'COMMON.INTERACT'
455 include 'COMMON.SBRIDGE'
456 include 'COMMON.CHAIN'
458 include 'COMMON.CONTROL'
459 include 'COMMON.TIME1'
460 include 'COMMON.MAXGRAD'
465 write (iout,*) "sum_gradient gvdwc, gvdwx"
467 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
468 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
469 & (gvdwcT(j,i),j=1,3)
474 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
475 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
476 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
479 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
480 C in virtual-bond-vector coordinates
483 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
485 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
486 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
488 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
490 c write (iout,'(i5,3f10.5,2x,f10.5)')
491 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
493 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
495 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
496 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
505 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
506 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
507 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
508 & wel_loc*gel_loc_long(j,i)+
509 & wcorr*gradcorr_long(j,i)+
510 & wcorr5*gradcorr5_long(j,i)+
511 & wcorr6*gradcorr6_long(j,i)+
512 & wturn6*gcorr6_turn_long(j,i)+
519 gradbufc(j,i)=wsc*gvdwc(j,i)+
520 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
521 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
522 & wel_loc*gel_loc_long(j,i)+
523 & wcorr*gradcorr_long(j,i)+
524 & wcorr5*gradcorr5_long(j,i)+
525 & wcorr6*gradcorr6_long(j,i)+
526 & wturn6*gcorr6_turn_long(j,i)+
534 gradbufc(j,i)=wsc*gvdwc(j,i)+
535 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
536 & welec*gelc_long(j,i)+
538 & wel_loc*gel_loc_long(j,i)+
539 & wcorr*gradcorr_long(j,i)+
540 & wcorr5*gradcorr5_long(j,i)+
541 & wcorr6*gradcorr6_long(j,i)+
542 & wturn6*gcorr6_turn_long(j,i)+
548 if (nfgtasks.gt.1) then
551 write (iout,*) "gradbufc before allreduce"
553 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
557 call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
558 & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
559 time_reduce=time_reduce+MPI_Wtime()-time00
561 write (iout,*) "gradbufc_sum after allreduce"
563 write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
568 time_allreduce=time_allreduce+MPI_Wtime()-time00
575 do i=igrad_start,igrad_end
576 do j=jgrad_start(i),jgrad_end(i)
578 gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
585 write (iout,*) "gradbufc"
587 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
597 gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
605 gradbufc(k,nres)=0.0d0
610 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
611 & wel_loc*gel_loc(j,i)+
612 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
613 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
614 & wel_loc*gel_loc_long(j,i)+
615 & wcorr*gradcorr_long(j,i)+
616 & wcorr5*gradcorr5_long(j,i)+
617 & wcorr6*gradcorr6_long(j,i)+
618 & wturn6*gcorr6_turn_long(j,i))+
620 & wcorr*gradcorr(j,i)+
621 & wturn3*gcorr3_turn(j,i)+
622 & wturn4*gcorr4_turn(j,i)+
623 & wcorr5*gradcorr5(j,i)+
624 & wcorr6*gradcorr6(j,i)+
625 & wturn6*gcorr6_turn(j,i)+
626 & wsccor*gsccorc(j,i)
627 & +wscloc*gscloc(j,i)
629 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
630 & wel_loc*gel_loc(j,i)+
631 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
632 & welec*gelc_long(j,i)+
633 & wel_loc*gel_loc_long(j,i)+
634 & wcorr*gcorr_long(j,i)+
635 & wcorr5*gradcorr5_long(j,i)+
636 & wcorr6*gradcorr6_long(j,i)+
637 & wturn6*gcorr6_turn_long(j,i))+
639 & wcorr*gradcorr(j,i)+
640 & wturn3*gcorr3_turn(j,i)+
641 & wturn4*gcorr4_turn(j,i)+
642 & wcorr5*gradcorr5(j,i)+
643 & wcorr6*gradcorr6(j,i)+
644 & wturn6*gcorr6_turn(j,i)+
645 & wsccor*gsccorc(j,i)
646 & +wscloc*gscloc(j,i)
649 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
650 & wscp*gradx_scp(j,i)+
652 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
653 & wsccor*gsccorx(j,i)
654 & +wscloc*gsclocx(j,i)
656 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
658 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
659 & wsccor*gsccorx(j,i)
660 & +wscloc*gsclocx(j,i)
665 write (iout,*) "gloc before adding corr"
667 write (iout,*) i,gloc(i,icg)
671 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
672 & +wcorr5*g_corr5_loc(i)
673 & +wcorr6*g_corr6_loc(i)
674 & +wturn4*gel_loc_turn4(i)
675 & +wturn3*gel_loc_turn3(i)
676 & +wturn6*gel_loc_turn6(i)
677 & +wel_loc*gel_loc_loc(i)
678 & +wsccor*gsccor_loc(i)
681 write (iout,*) "gloc after adding corr"
683 write (iout,*) i,gloc(i,icg)
687 if (nfgtasks.gt.1) then
690 gradbufc(j,i)=gradc(j,i,icg)
691 gradbufx(j,i)=gradx(j,i,icg)
695 glocbuf(i)=gloc(i,icg)
698 call MPI_Barrier(FG_COMM,IERR)
699 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
701 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
702 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
703 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
704 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
705 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
706 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
707 time_reduce=time_reduce+MPI_Wtime()-time00
709 write (iout,*) "gloc after reduce"
711 write (iout,*) i,gloc(i,icg)
716 if (gnorm_check) then
718 c Compute the maximum elements of the gradient
728 gcorr3_turn_max=0.0d0
729 gcorr4_turn_max=0.0d0
732 gcorr6_turn_max=0.0d0
742 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
743 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
745 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
746 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
748 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
749 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
750 & gvdwc_scp_max=gvdwc_scp_norm
751 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
752 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
753 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
754 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
755 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
756 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
757 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
758 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
759 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
760 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
761 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
762 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
763 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
765 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
766 & gcorr3_turn_max=gcorr3_turn_norm
767 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
769 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
770 & gcorr4_turn_max=gcorr4_turn_norm
771 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
772 if (gradcorr5_norm.gt.gradcorr5_max)
773 & gradcorr5_max=gradcorr5_norm
774 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
775 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
776 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
778 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
779 & gcorr6_turn_max=gcorr6_turn_norm
780 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
781 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
782 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
783 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
784 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
785 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
787 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
788 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
790 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
791 if (gradx_scp_norm.gt.gradx_scp_max)
792 & gradx_scp_max=gradx_scp_norm
793 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
794 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
795 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
796 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
797 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
798 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
799 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
800 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
804 open(istat,file=statname,position="append")
806 open(istat,file=statname,access="append")
808 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
809 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
810 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
811 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
812 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
813 & gsccorx_max,gsclocx_max
815 if (gvdwc_max.gt.1.0d4) then
816 write (iout,*) "gvdwc gvdwx gradb gradbx"
818 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
819 & gradb(j,i),gradbx(j,i),j=1,3)
821 call pdbout(0.0d0,'cipiszcze',iout)
827 write (iout,*) "gradc gradx gloc"
829 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
830 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
834 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
838 c-------------------------------------------------------------------------------
839 subroutine rescale_weights(t_bath)
840 implicit real*8 (a-h,o-z)
842 include 'COMMON.IOUNITS'
843 include 'COMMON.FFIELD'
844 include 'COMMON.SBRIDGE'
845 double precision kfac /2.4d0/
846 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
848 c facT=2*temp0/(t_bath+temp0)
849 if (rescale_mode.eq.0) then
855 else if (rescale_mode.eq.1) then
856 facT=kfac/(kfac-1.0d0+t_bath/temp0)
857 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
858 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
859 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
860 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
861 else if (rescale_mode.eq.2) then
867 facT=licznik/dlog(dexp(x)+dexp(-x))
868 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
869 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
870 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
871 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
873 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
874 write (*,*) "Wrong RESCALE_MODE",rescale_mode
876 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
880 welec=weights(3)*fact
881 wcorr=weights(4)*fact3
882 wcorr5=weights(5)*fact4
883 wcorr6=weights(6)*fact5
884 wel_loc=weights(7)*fact2
885 wturn3=weights(8)*fact2
886 wturn4=weights(9)*fact3
887 wturn6=weights(10)*fact5
888 wtor=weights(13)*fact
889 wtor_d=weights(14)*fact2
890 wsccor=weights(21)*fact
893 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
897 C------------------------------------------------------------------------
898 subroutine enerprint(energia)
899 implicit real*8 (a-h,o-z)
901 include 'COMMON.IOUNITS'
902 include 'COMMON.FFIELD'
903 include 'COMMON.SBRIDGE'
905 double precision energia(0:n_ene)
908 evdw=energia(22)+wsct*energia(23)
914 evdw2=energia(2)+energia(18)
926 eello_turn3=energia(8)
927 eello_turn4=energia(9)
928 eello_turn6=energia(10)
934 edihcnstr=energia(19)
939 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
940 & estr,wbond,ebe,wang,
941 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
943 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
944 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
947 10 format (/'Virtual-chain energies:'//
948 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
949 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
950 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
951 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
952 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
953 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
954 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
955 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
956 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
957 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
958 & ' (SS bridges & dist. cnstr.)'/
959 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
960 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
961 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
962 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
963 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
964 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
965 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
966 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
967 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
968 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
969 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
970 & 'ETOT= ',1pE16.6,' (total)')
972 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
973 & estr,wbond,ebe,wang,
974 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
976 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
977 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
978 & ebr*nss,Uconst,etot
979 10 format (/'Virtual-chain energies:'//
980 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
981 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
982 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
983 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
984 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
985 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
986 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
987 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
988 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
989 & ' (SS bridges & dist. cnstr.)'/
990 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
991 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
992 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
993 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
994 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
995 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
996 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
997 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
998 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
999 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1000 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1001 & 'ETOT= ',1pE16.6,' (total)')
1005 C-----------------------------------------------------------------------
1006 subroutine elj(evdw,evdw_p,evdw_m)
1008 C This subroutine calculates the interaction energy of nonbonded side chains
1009 C assuming the LJ potential of interaction.
1011 implicit real*8 (a-h,o-z)
1012 include 'DIMENSIONS'
1013 parameter (accur=1.0d-10)
1014 include 'COMMON.GEO'
1015 include 'COMMON.VAR'
1016 include 'COMMON.LOCAL'
1017 include 'COMMON.CHAIN'
1018 include 'COMMON.DERIV'
1019 include 'COMMON.INTERACT'
1020 include 'COMMON.TORSION'
1021 include 'COMMON.SBRIDGE'
1022 include 'COMMON.NAMES'
1023 include 'COMMON.IOUNITS'
1024 include 'COMMON.CONTACTS'
1026 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1028 do i=iatsc_s,iatsc_e
1037 C Calculate SC interaction energy.
1039 do iint=1,nint_gr(i)
1040 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1041 cd & 'iend=',iend(i,iint)
1042 do j=istart(i,iint),iend(i,iint)
1047 C Change 12/1/95 to calculate four-body interactions
1048 rij=xj*xj+yj*yj+zj*zj
1050 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1051 eps0ij=eps(itypi,itypj)
1053 e1=fac*fac*aa(itypi,itypj)
1054 e2=fac*bb(itypi,itypj)
1056 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1057 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1058 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1059 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1060 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1061 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1063 if (bb(itypi,itypj).gt.0) then
1064 evdw_p=evdw_p+evdwij
1066 evdw_m=evdw_m+evdwij
1072 C Calculate the components of the gradient in DC and X
1074 fac=-rrij*(e1+evdwij)
1079 if (bb(itypi,itypj).gt.0.0d0) then
1081 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1082 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1083 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1084 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1088 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1089 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1090 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1091 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1096 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1097 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1098 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1099 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1104 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1108 C 12/1/95, revised on 5/20/97
1110 C Calculate the contact function. The ith column of the array JCONT will
1111 C contain the numbers of atoms that make contacts with the atom I (of numbers
1112 C greater than I). The arrays FACONT and GACONT will contain the values of
1113 C the contact function and its derivative.
1115 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1116 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1117 C Uncomment next line, if the correlation interactions are contact function only
1118 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1120 sigij=sigma(itypi,itypj)
1121 r0ij=rs0(itypi,itypj)
1123 C Check whether the SC's are not too far to make a contact.
1126 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1127 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1129 if (fcont.gt.0.0D0) then
1130 C If the SC-SC distance if close to sigma, apply spline.
1131 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1132 cAdam & fcont1,fprimcont1)
1133 cAdam fcont1=1.0d0-fcont1
1134 cAdam if (fcont1.gt.0.0d0) then
1135 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1136 cAdam fcont=fcont*fcont1
1138 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1139 cga eps0ij=1.0d0/dsqrt(eps0ij)
1141 cga gg(k)=gg(k)*eps0ij
1143 cga eps0ij=-evdwij*eps0ij
1144 C Uncomment for AL's type of SC correlation interactions.
1145 cadam eps0ij=-evdwij
1146 num_conti=num_conti+1
1147 jcont(num_conti,i)=j
1148 facont(num_conti,i)=fcont*eps0ij
1149 fprimcont=eps0ij*fprimcont/rij
1151 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1152 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1153 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1154 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1155 gacont(1,num_conti,i)=-fprimcont*xj
1156 gacont(2,num_conti,i)=-fprimcont*yj
1157 gacont(3,num_conti,i)=-fprimcont*zj
1158 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1159 cd write (iout,'(2i3,3f10.5)')
1160 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1166 num_cont(i)=num_conti
1170 gvdwc(j,i)=expon*gvdwc(j,i)
1171 gvdwx(j,i)=expon*gvdwx(j,i)
1174 C******************************************************************************
1178 C To save time, the factor of EXPON has been extracted from ALL components
1179 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1182 C******************************************************************************
1185 C-----------------------------------------------------------------------------
1186 subroutine eljk(evdw,evdw_p,evdw_m)
1188 C This subroutine calculates the interaction energy of nonbonded side chains
1189 C assuming the LJK potential of interaction.
1191 implicit real*8 (a-h,o-z)
1192 include 'DIMENSIONS'
1193 include 'COMMON.GEO'
1194 include 'COMMON.VAR'
1195 include 'COMMON.LOCAL'
1196 include 'COMMON.CHAIN'
1197 include 'COMMON.DERIV'
1198 include 'COMMON.INTERACT'
1199 include 'COMMON.IOUNITS'
1200 include 'COMMON.NAMES'
1203 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1205 do i=iatsc_s,iatsc_e
1212 C Calculate SC interaction energy.
1214 do iint=1,nint_gr(i)
1215 do j=istart(i,iint),iend(i,iint)
1220 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1221 fac_augm=rrij**expon
1222 e_augm=augm(itypi,itypj)*fac_augm
1223 r_inv_ij=dsqrt(rrij)
1225 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1226 fac=r_shift_inv**expon
1227 e1=fac*fac*aa(itypi,itypj)
1228 e2=fac*bb(itypi,itypj)
1230 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1231 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1232 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1233 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1234 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1235 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1236 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1238 if (bb(itypi,itypj).gt.0) then
1239 evdw_p=evdw_p+evdwij
1241 evdw_m=evdw_m+evdwij
1247 C Calculate the components of the gradient in DC and X
1249 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1254 if (bb(itypi,itypj).gt.0.0d0) then
1256 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1257 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1258 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1259 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1263 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1264 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1265 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1266 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1271 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1272 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1273 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1274 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1279 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1287 gvdwc(j,i)=expon*gvdwc(j,i)
1288 gvdwx(j,i)=expon*gvdwx(j,i)
1293 C-----------------------------------------------------------------------------
1294 subroutine ebp(evdw,evdw_p,evdw_m)
1296 C This subroutine calculates the interaction energy of nonbonded side chains
1297 C assuming the Berne-Pechukas potential of interaction.
1299 implicit real*8 (a-h,o-z)
1300 include 'DIMENSIONS'
1301 include 'COMMON.GEO'
1302 include 'COMMON.VAR'
1303 include 'COMMON.LOCAL'
1304 include 'COMMON.CHAIN'
1305 include 'COMMON.DERIV'
1306 include 'COMMON.NAMES'
1307 include 'COMMON.INTERACT'
1308 include 'COMMON.IOUNITS'
1309 include 'COMMON.CALC'
1310 common /srutu/ icall
1311 c double precision rrsave(maxdim)
1314 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1316 c if (icall.eq.0) then
1322 do i=iatsc_s,iatsc_e
1328 dxi=dc_norm(1,nres+i)
1329 dyi=dc_norm(2,nres+i)
1330 dzi=dc_norm(3,nres+i)
1331 c dsci_inv=dsc_inv(itypi)
1332 dsci_inv=vbld_inv(i+nres)
1334 C Calculate SC interaction energy.
1336 do iint=1,nint_gr(i)
1337 do j=istart(i,iint),iend(i,iint)
1340 c dscj_inv=dsc_inv(itypj)
1341 dscj_inv=vbld_inv(j+nres)
1342 chi1=chi(itypi,itypj)
1343 chi2=chi(itypj,itypi)
1350 alf12=0.5D0*(alf1+alf2)
1351 C For diagnostics only!!!
1364 dxj=dc_norm(1,nres+j)
1365 dyj=dc_norm(2,nres+j)
1366 dzj=dc_norm(3,nres+j)
1367 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1368 cd if (icall.eq.0) then
1374 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1376 C Calculate whole angle-dependent part of epsilon and contributions
1377 C to its derivatives
1378 fac=(rrij*sigsq)**expon2
1379 e1=fac*fac*aa(itypi,itypj)
1380 e2=fac*bb(itypi,itypj)
1381 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1382 eps2der=evdwij*eps3rt
1383 eps3der=evdwij*eps2rt
1384 evdwij=evdwij*eps2rt*eps3rt
1386 if (bb(itypi,itypj).gt.0) then
1387 evdw_p=evdw_p+evdwij
1389 evdw_m=evdw_m+evdwij
1395 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1396 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1397 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1398 cd & restyp(itypi),i,restyp(itypj),j,
1399 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1400 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1401 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1404 C Calculate gradient components.
1405 e1=e1*eps1*eps2rt**2*eps3rt**2
1406 fac=-expon*(e1+evdwij)
1409 C Calculate radial part of the gradient
1413 C Calculate the angular part of the gradient and sum add the contributions
1414 C to the appropriate components of the Cartesian gradient.
1416 if (bb(itypi,itypj).gt.0) then
1430 C-----------------------------------------------------------------------------
1431 subroutine egb(evdw,evdw_p,evdw_m)
1433 C This subroutine calculates the interaction energy of nonbonded side chains
1434 C assuming the Gay-Berne potential of interaction.
1436 implicit real*8 (a-h,o-z)
1437 include 'DIMENSIONS'
1438 include 'COMMON.GEO'
1439 include 'COMMON.VAR'
1440 include 'COMMON.LOCAL'
1441 include 'COMMON.CHAIN'
1442 include 'COMMON.DERIV'
1443 include 'COMMON.NAMES'
1444 include 'COMMON.INTERACT'
1445 include 'COMMON.IOUNITS'
1446 include 'COMMON.CALC'
1447 include 'COMMON.CONTROL'
1450 ccccc energy_dec=.false.
1451 c write(iout,*) 'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1456 c if (icall.eq.0) lprn=.false.
1458 do i=iatsc_s,iatsc_e
1464 dxi=dc_norm(1,nres+i)
1465 dyi=dc_norm(2,nres+i)
1466 dzi=dc_norm(3,nres+i)
1467 c dsci_inv=dsc_inv(itypi)
1468 dsci_inv=vbld_inv(i+nres)
1469 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1470 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1472 C Calculate SC interaction energy.
1474 do iint=1,nint_gr(i)
1475 do j=istart(i,iint),iend(i,iint)
1478 c dscj_inv=dsc_inv(itypj)
1479 dscj_inv=vbld_inv(j+nres)
1480 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1481 c & 1.0d0/vbld(j+nres)
1482 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1483 sig0ij=sigma(itypi,itypj)
1484 chi1=chi(itypi,itypj)
1485 chi2=chi(itypj,itypi)
1492 alf12=0.5D0*(alf1+alf2)
1493 C For diagnostics only!!!
1506 dxj=dc_norm(1,nres+j)
1507 dyj=dc_norm(2,nres+j)
1508 dzj=dc_norm(3,nres+j)
1509 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1510 c write (iout,*) "j",j," dc_norm",
1511 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1512 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1514 C Calculate angle-dependent terms of energy and contributions to their
1518 sig=sig0ij*dsqrt(sigsq)
1519 rij_shift=1.0D0/rij-sig+sig0ij
1520 c for diagnostics; uncomment
1521 c rij_shift=1.2*sig0ij
1522 C I hate to put IF's in the loops, but here don't have another choice!!!!
1523 if (rij_shift.le.0.0D0) then
1525 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1526 cd & restyp(itypi),i,restyp(itypj),j,
1527 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1531 c---------------------------------------------------------------
1532 rij_shift=1.0D0/rij_shift
1533 fac=rij_shift**expon
1534 e1=fac*fac*aa(itypi,itypj)
1535 e2=fac*bb(itypi,itypj)
1536 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1537 eps2der=evdwij*eps3rt
1538 eps3der=evdwij*eps2rt
1539 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1540 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1541 evdwij=evdwij*eps2rt*eps3rt
1543 if (bb(itypi,itypj).gt.0) then
1544 evdw_p=evdw_p+evdwij
1546 evdw_m=evdw_m+evdwij
1552 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1553 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1554 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1555 & restyp(itypi),i,restyp(itypj),j,
1556 & epsi,sigm,chi1,chi2,chip1,chip2,
1557 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1558 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1562 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1565 C Calculate gradient components.
1566 e1=e1*eps1*eps2rt**2*eps3rt**2
1567 fac=-expon*(e1+evdwij)*rij_shift
1571 C Calculate the radial part of the gradient
1575 C Calculate angular part of the gradient.
1577 if (bb(itypi,itypj).gt.0) then
1588 c write (iout,*) "Number of loop steps in EGB:",ind
1589 cccc energy_dec=.false.
1592 C-----------------------------------------------------------------------------
1593 subroutine egbv(evdw,evdw_p,evdw_m)
1595 C This subroutine calculates the interaction energy of nonbonded side chains
1596 C assuming the Gay-Berne-Vorobjev potential of interaction.
1598 implicit real*8 (a-h,o-z)
1599 include 'DIMENSIONS'
1600 include 'COMMON.GEO'
1601 include 'COMMON.VAR'
1602 include 'COMMON.LOCAL'
1603 include 'COMMON.CHAIN'
1604 include 'COMMON.DERIV'
1605 include 'COMMON.NAMES'
1606 include 'COMMON.INTERACT'
1607 include 'COMMON.IOUNITS'
1608 include 'COMMON.CALC'
1609 common /srutu/ icall
1612 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1615 c if (icall.eq.0) lprn=.true.
1617 do i=iatsc_s,iatsc_e
1623 dxi=dc_norm(1,nres+i)
1624 dyi=dc_norm(2,nres+i)
1625 dzi=dc_norm(3,nres+i)
1626 c dsci_inv=dsc_inv(itypi)
1627 dsci_inv=vbld_inv(i+nres)
1629 C Calculate SC interaction energy.
1631 do iint=1,nint_gr(i)
1632 do j=istart(i,iint),iend(i,iint)
1635 c dscj_inv=dsc_inv(itypj)
1636 dscj_inv=vbld_inv(j+nres)
1637 sig0ij=sigma(itypi,itypj)
1638 r0ij=r0(itypi,itypj)
1639 chi1=chi(itypi,itypj)
1640 chi2=chi(itypj,itypi)
1647 alf12=0.5D0*(alf1+alf2)
1648 C For diagnostics only!!!
1661 dxj=dc_norm(1,nres+j)
1662 dyj=dc_norm(2,nres+j)
1663 dzj=dc_norm(3,nres+j)
1664 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1666 C Calculate angle-dependent terms of energy and contributions to their
1670 sig=sig0ij*dsqrt(sigsq)
1671 rij_shift=1.0D0/rij-sig+r0ij
1672 C I hate to put IF's in the loops, but here don't have another choice!!!!
1673 if (rij_shift.le.0.0D0) then
1678 c---------------------------------------------------------------
1679 rij_shift=1.0D0/rij_shift
1680 fac=rij_shift**expon
1681 e1=fac*fac*aa(itypi,itypj)
1682 e2=fac*bb(itypi,itypj)
1683 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1684 eps2der=evdwij*eps3rt
1685 eps3der=evdwij*eps2rt
1686 fac_augm=rrij**expon
1687 e_augm=augm(itypi,itypj)*fac_augm
1688 evdwij=evdwij*eps2rt*eps3rt
1690 if (bb(itypi,itypj).gt.0) then
1691 evdw_p=evdw_p+evdwij+e_augm
1693 evdw_m=evdw_m+evdwij+e_augm
1696 evdw=evdw+evdwij+e_augm
1699 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1700 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1701 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1702 & restyp(itypi),i,restyp(itypj),j,
1703 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1704 & chi1,chi2,chip1,chip2,
1705 & eps1,eps2rt**2,eps3rt**2,
1706 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1709 C Calculate gradient components.
1710 e1=e1*eps1*eps2rt**2*eps3rt**2
1711 fac=-expon*(e1+evdwij)*rij_shift
1713 fac=rij*fac-2*expon*rrij*e_augm
1714 C Calculate the radial part of the gradient
1718 C Calculate angular part of the gradient.
1720 if (bb(itypi,itypj).gt.0) then
1732 C-----------------------------------------------------------------------------
1733 subroutine sc_angular
1734 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1735 C om12. Called by ebp, egb, and egbv.
1737 include 'COMMON.CALC'
1738 include 'COMMON.IOUNITS'
1742 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1743 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1744 om12=dxi*dxj+dyi*dyj+dzi*dzj
1746 C Calculate eps1(om12) and its derivative in om12
1747 faceps1=1.0D0-om12*chiom12
1748 faceps1_inv=1.0D0/faceps1
1749 eps1=dsqrt(faceps1_inv)
1750 C Following variable is eps1*deps1/dom12
1751 eps1_om12=faceps1_inv*chiom12
1756 c write (iout,*) "om12",om12," eps1",eps1
1757 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1762 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1763 sigsq=1.0D0-facsig*faceps1_inv
1764 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1765 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1766 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1772 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1773 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1775 C Calculate eps2 and its derivatives in om1, om2, and om12.
1778 chipom12=chip12*om12
1779 facp=1.0D0-om12*chipom12
1781 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1782 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1783 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1784 C Following variable is the square root of eps2
1785 eps2rt=1.0D0-facp1*facp_inv
1786 C Following three variables are the derivatives of the square root of eps
1787 C in om1, om2, and om12.
1788 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1789 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1790 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1791 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1792 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1793 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1794 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1795 c & " eps2rt_om12",eps2rt_om12
1796 C Calculate whole angle-dependent part of epsilon and contributions
1797 C to its derivatives
1801 C----------------------------------------------------------------------------
1802 subroutine sc_grad_T
1803 implicit real*8 (a-h,o-z)
1804 include 'DIMENSIONS'
1805 include 'COMMON.CHAIN'
1806 include 'COMMON.DERIV'
1807 include 'COMMON.CALC'
1808 include 'COMMON.IOUNITS'
1809 double precision dcosom1(3),dcosom2(3)
1810 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1811 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1812 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1813 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1817 c eom12=evdwij*eps1_om12
1819 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1820 c & " sigder",sigder
1821 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1822 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1824 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1825 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1828 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1830 c write (iout,*) "gg",(gg(k),k=1,3)
1832 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1833 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1834 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1835 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1836 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1837 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1838 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1839 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1840 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1841 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1844 C Calculate the components of the gradient in DC and X
1848 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1852 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1853 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1858 C----------------------------------------------------------------------------
1860 implicit real*8 (a-h,o-z)
1861 include 'DIMENSIONS'
1862 include 'COMMON.CHAIN'
1863 include 'COMMON.DERIV'
1864 include 'COMMON.CALC'
1865 include 'COMMON.IOUNITS'
1866 double precision dcosom1(3),dcosom2(3)
1867 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1868 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1869 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1870 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1874 c eom12=evdwij*eps1_om12
1876 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1877 c & " sigder",sigder
1878 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1879 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1881 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1882 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1885 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1887 c write (iout,*) "gg",(gg(k),k=1,3)
1889 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1890 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1891 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1892 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1893 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1894 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1895 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1896 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1897 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1898 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1901 C Calculate the components of the gradient in DC and X
1905 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1909 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1910 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1914 C-----------------------------------------------------------------------
1915 subroutine e_softsphere(evdw)
1917 C This subroutine calculates the interaction energy of nonbonded side chains
1918 C assuming the LJ potential of interaction.
1920 implicit real*8 (a-h,o-z)
1921 include 'DIMENSIONS'
1922 parameter (accur=1.0d-10)
1923 include 'COMMON.GEO'
1924 include 'COMMON.VAR'
1925 include 'COMMON.LOCAL'
1926 include 'COMMON.CHAIN'
1927 include 'COMMON.DERIV'
1928 include 'COMMON.INTERACT'
1929 include 'COMMON.TORSION'
1930 include 'COMMON.SBRIDGE'
1931 include 'COMMON.NAMES'
1932 include 'COMMON.IOUNITS'
1933 include 'COMMON.CONTACTS'
1935 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1937 do i=iatsc_s,iatsc_e
1944 C Calculate SC interaction energy.
1946 do iint=1,nint_gr(i)
1947 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1948 cd & 'iend=',iend(i,iint)
1949 do j=istart(i,iint),iend(i,iint)
1954 rij=xj*xj+yj*yj+zj*zj
1955 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1956 r0ij=r0(itypi,itypj)
1958 c print *,i,j,r0ij,dsqrt(rij)
1959 if (rij.lt.r0ijsq) then
1960 evdwij=0.25d0*(rij-r0ijsq)**2
1968 C Calculate the components of the gradient in DC and X
1974 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1975 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1976 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1977 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1981 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1989 C--------------------------------------------------------------------------
1990 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1993 C Soft-sphere potential of p-p interaction
1995 implicit real*8 (a-h,o-z)
1996 include 'DIMENSIONS'
1997 include 'COMMON.CONTROL'
1998 include 'COMMON.IOUNITS'
1999 include 'COMMON.GEO'
2000 include 'COMMON.VAR'
2001 include 'COMMON.LOCAL'
2002 include 'COMMON.CHAIN'
2003 include 'COMMON.DERIV'
2004 include 'COMMON.INTERACT'
2005 include 'COMMON.CONTACTS'
2006 include 'COMMON.TORSION'
2007 include 'COMMON.VECTORS'
2008 include 'COMMON.FFIELD'
2010 cd write(iout,*) 'In EELEC_soft_sphere'
2017 do i=iatel_s,iatel_e
2021 xmedi=c(1,i)+0.5d0*dxi
2022 ymedi=c(2,i)+0.5d0*dyi
2023 zmedi=c(3,i)+0.5d0*dzi
2025 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2026 do j=ielstart(i),ielend(i)
2030 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2031 r0ij=rpp(iteli,itelj)
2036 xj=c(1,j)+0.5D0*dxj-xmedi
2037 yj=c(2,j)+0.5D0*dyj-ymedi
2038 zj=c(3,j)+0.5D0*dzj-zmedi
2039 rij=xj*xj+yj*yj+zj*zj
2040 if (rij.lt.r0ijsq) then
2041 evdw1ij=0.25d0*(rij-r0ijsq)**2
2049 C Calculate contributions to the Cartesian gradient.
2055 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2056 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2059 * Loop over residues i+1 thru j-1.
2063 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2068 cgrad do i=nnt,nct-1
2070 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2072 cgrad do j=i+1,nct-1
2074 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2080 c------------------------------------------------------------------------------
2081 subroutine vec_and_deriv
2082 implicit real*8 (a-h,o-z)
2083 include 'DIMENSIONS'
2087 include 'COMMON.IOUNITS'
2088 include 'COMMON.GEO'
2089 include 'COMMON.VAR'
2090 include 'COMMON.LOCAL'
2091 include 'COMMON.CHAIN'
2092 include 'COMMON.VECTORS'
2093 include 'COMMON.SETUP'
2094 include 'COMMON.TIME1'
2095 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2096 C Compute the local reference systems. For reference system (i), the
2097 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2098 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2100 do i=ivec_start,ivec_end
2104 if (i.eq.nres-1) then
2105 C Case of the last full residue
2106 C Compute the Z-axis
2107 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2108 costh=dcos(pi-theta(nres))
2109 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2113 C Compute the derivatives of uz
2115 uzder(2,1,1)=-dc_norm(3,i-1)
2116 uzder(3,1,1)= dc_norm(2,i-1)
2117 uzder(1,2,1)= dc_norm(3,i-1)
2119 uzder(3,2,1)=-dc_norm(1,i-1)
2120 uzder(1,3,1)=-dc_norm(2,i-1)
2121 uzder(2,3,1)= dc_norm(1,i-1)
2124 uzder(2,1,2)= dc_norm(3,i)
2125 uzder(3,1,2)=-dc_norm(2,i)
2126 uzder(1,2,2)=-dc_norm(3,i)
2128 uzder(3,2,2)= dc_norm(1,i)
2129 uzder(1,3,2)= dc_norm(2,i)
2130 uzder(2,3,2)=-dc_norm(1,i)
2132 C Compute the Y-axis
2135 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2137 C Compute the derivatives of uy
2140 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2141 & -dc_norm(k,i)*dc_norm(j,i-1)
2142 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2144 uyder(j,j,1)=uyder(j,j,1)-costh
2145 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2150 uygrad(l,k,j,i)=uyder(l,k,j)
2151 uzgrad(l,k,j,i)=uzder(l,k,j)
2155 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2156 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2157 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2158 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2161 C Compute the Z-axis
2162 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2163 costh=dcos(pi-theta(i+2))
2164 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2168 C Compute the derivatives of uz
2170 uzder(2,1,1)=-dc_norm(3,i+1)
2171 uzder(3,1,1)= dc_norm(2,i+1)
2172 uzder(1,2,1)= dc_norm(3,i+1)
2174 uzder(3,2,1)=-dc_norm(1,i+1)
2175 uzder(1,3,1)=-dc_norm(2,i+1)
2176 uzder(2,3,1)= dc_norm(1,i+1)
2179 uzder(2,1,2)= dc_norm(3,i)
2180 uzder(3,1,2)=-dc_norm(2,i)
2181 uzder(1,2,2)=-dc_norm(3,i)
2183 uzder(3,2,2)= dc_norm(1,i)
2184 uzder(1,3,2)= dc_norm(2,i)
2185 uzder(2,3,2)=-dc_norm(1,i)
2187 C Compute the Y-axis
2190 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2192 C Compute the derivatives of uy
2195 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2196 & -dc_norm(k,i)*dc_norm(j,i+1)
2197 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2199 uyder(j,j,1)=uyder(j,j,1)-costh
2200 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2205 uygrad(l,k,j,i)=uyder(l,k,j)
2206 uzgrad(l,k,j,i)=uzder(l,k,j)
2210 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2211 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2212 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2213 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2217 vbld_inv_temp(1)=vbld_inv(i+1)
2218 if (i.lt.nres-1) then
2219 vbld_inv_temp(2)=vbld_inv(i+2)
2221 vbld_inv_temp(2)=vbld_inv(i)
2226 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2227 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2232 #if defined(PARVEC) && defined(MPI)
2233 if (nfgtasks1.gt.1) then
2235 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2236 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2237 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2238 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2239 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2241 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2242 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2244 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2245 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2246 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2247 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2248 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2249 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2250 time_gather=time_gather+MPI_Wtime()-time00
2252 c if (fg_rank.eq.0) then
2253 c write (iout,*) "Arrays UY and UZ"
2255 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2262 C-----------------------------------------------------------------------------
2263 subroutine check_vecgrad
2264 implicit real*8 (a-h,o-z)
2265 include 'DIMENSIONS'
2266 include 'COMMON.IOUNITS'
2267 include 'COMMON.GEO'
2268 include 'COMMON.VAR'
2269 include 'COMMON.LOCAL'
2270 include 'COMMON.CHAIN'
2271 include 'COMMON.VECTORS'
2272 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2273 dimension uyt(3,maxres),uzt(3,maxres)
2274 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2275 double precision delta /1.0d-7/
2278 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2279 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2280 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2281 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2282 cd & (dc_norm(if90,i),if90=1,3)
2283 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2284 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2285 cd write(iout,'(a)')
2291 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2292 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2305 cd write (iout,*) 'i=',i
2307 erij(k)=dc_norm(k,i)
2311 dc_norm(k,i)=erij(k)
2313 dc_norm(j,i)=dc_norm(j,i)+delta
2314 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2316 c dc_norm(k,i)=dc_norm(k,i)/fac
2318 c write (iout,*) (dc_norm(k,i),k=1,3)
2319 c write (iout,*) (erij(k),k=1,3)
2322 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2323 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2324 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2325 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2327 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2328 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2329 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2332 dc_norm(k,i)=erij(k)
2335 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2336 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2337 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2338 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2339 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2340 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2341 cd write (iout,'(a)')
2346 C--------------------------------------------------------------------------
2347 subroutine set_matrices
2348 implicit real*8 (a-h,o-z)
2349 include 'DIMENSIONS'
2352 include "COMMON.SETUP"
2354 integer status(MPI_STATUS_SIZE)
2356 include 'COMMON.IOUNITS'
2357 include 'COMMON.GEO'
2358 include 'COMMON.VAR'
2359 include 'COMMON.LOCAL'
2360 include 'COMMON.CHAIN'
2361 include 'COMMON.DERIV'
2362 include 'COMMON.INTERACT'
2363 include 'COMMON.CONTACTS'
2364 include 'COMMON.TORSION'
2365 include 'COMMON.VECTORS'
2366 include 'COMMON.FFIELD'
2367 double precision auxvec(2),auxmat(2,2)
2369 C Compute the virtual-bond-torsional-angle dependent quantities needed
2370 C to calculate the el-loc multibody terms of various order.
2373 do i=ivec_start+2,ivec_end+2
2377 if (i .lt. nres+1) then
2414 if (i .gt. 3 .and. i .lt. nres+1) then
2415 obrot_der(1,i-2)=-sin1
2416 obrot_der(2,i-2)= cos1
2417 Ugder(1,1,i-2)= sin1
2418 Ugder(1,2,i-2)=-cos1
2419 Ugder(2,1,i-2)=-cos1
2420 Ugder(2,2,i-2)=-sin1
2423 obrot2_der(1,i-2)=-dwasin2
2424 obrot2_der(2,i-2)= dwacos2
2425 Ug2der(1,1,i-2)= dwasin2
2426 Ug2der(1,2,i-2)=-dwacos2
2427 Ug2der(2,1,i-2)=-dwacos2
2428 Ug2der(2,2,i-2)=-dwasin2
2430 obrot_der(1,i-2)=0.0d0
2431 obrot_der(2,i-2)=0.0d0
2432 Ugder(1,1,i-2)=0.0d0
2433 Ugder(1,2,i-2)=0.0d0
2434 Ugder(2,1,i-2)=0.0d0
2435 Ugder(2,2,i-2)=0.0d0
2436 obrot2_der(1,i-2)=0.0d0
2437 obrot2_der(2,i-2)=0.0d0
2438 Ug2der(1,1,i-2)=0.0d0
2439 Ug2der(1,2,i-2)=0.0d0
2440 Ug2der(2,1,i-2)=0.0d0
2441 Ug2der(2,2,i-2)=0.0d0
2443 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2444 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2445 iti = itortyp(itype(i-2))
2449 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2450 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2451 iti1 = itortyp(itype(i-1))
2455 cd write (iout,*) '*******i',i,' iti1',iti
2456 cd write (iout,*) 'b1',b1(:,iti)
2457 cd write (iout,*) 'b2',b2(:,iti)
2458 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2459 c if (i .gt. iatel_s+2) then
2460 if (i .gt. nnt+2) then
2461 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2462 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2463 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2465 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2466 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2467 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2468 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2469 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2480 DtUg2(l,k,i-2)=0.0d0
2484 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2485 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2487 muder(k,i-2)=Ub2der(k,i-2)
2489 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2490 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2491 iti1 = itortyp(itype(i-1))
2496 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2498 cd write (iout,*) 'mu ',mu(:,i-2)
2499 cd write (iout,*) 'mu1',mu1(:,i-2)
2500 cd write (iout,*) 'mu2',mu2(:,i-2)
2501 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2503 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2504 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2505 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2506 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2507 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2508 C Vectors and matrices dependent on a single virtual-bond dihedral.
2509 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2510 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2511 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2512 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2513 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2514 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2515 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2516 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2517 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2520 C Matrices dependent on two consecutive virtual-bond dihedrals.
2521 C The order of matrices is from left to right.
2522 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2524 c do i=max0(ivec_start,2),ivec_end
2526 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2527 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2528 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2529 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2530 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2531 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2532 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2533 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2536 #if defined(MPI) && defined(PARMAT)
2538 c if (fg_rank.eq.0) then
2539 write (iout,*) "Arrays UG and UGDER before GATHER"
2541 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2542 & ((ug(l,k,i),l=1,2),k=1,2),
2543 & ((ugder(l,k,i),l=1,2),k=1,2)
2545 write (iout,*) "Arrays UG2 and UG2DER"
2547 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2548 & ((ug2(l,k,i),l=1,2),k=1,2),
2549 & ((ug2der(l,k,i),l=1,2),k=1,2)
2551 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2553 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2554 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2555 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2557 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2559 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2560 & costab(i),sintab(i),costab2(i),sintab2(i)
2562 write (iout,*) "Array MUDER"
2564 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2568 if (nfgtasks.gt.1) then
2570 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2571 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2572 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2574 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2575 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2577 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2578 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2580 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2581 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2583 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2584 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2586 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2587 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2589 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2590 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2592 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2593 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2594 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2595 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2596 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2597 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2598 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2599 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2600 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2601 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2602 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2603 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2604 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2606 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2607 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2609 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2610 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2612 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2613 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2615 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2616 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2618 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2619 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2621 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2622 & ivec_count(fg_rank1),
2623 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2625 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2626 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2628 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2629 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2631 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2632 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2634 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2635 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2637 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2638 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2640 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2641 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2643 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2644 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2646 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2647 & ivec_count(fg_rank1),
2648 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2650 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2651 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2653 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2654 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2656 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2657 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2659 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2660 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2662 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2663 & ivec_count(fg_rank1),
2664 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2666 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2667 & ivec_count(fg_rank1),
2668 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2670 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2671 & ivec_count(fg_rank1),
2672 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2673 & MPI_MAT2,FG_COMM1,IERR)
2674 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2675 & ivec_count(fg_rank1),
2676 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2677 & MPI_MAT2,FG_COMM1,IERR)
2680 c Passes matrix info through the ring
2683 if (irecv.lt.0) irecv=nfgtasks1-1
2686 if (inext.ge.nfgtasks1) inext=0
2688 c write (iout,*) "isend",isend," irecv",irecv
2690 lensend=lentyp(isend)
2691 lenrecv=lentyp(irecv)
2692 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2693 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2694 c & MPI_ROTAT1(lensend),inext,2200+isend,
2695 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2696 c & iprev,2200+irecv,FG_COMM,status,IERR)
2697 c write (iout,*) "Gather ROTAT1"
2699 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2700 c & MPI_ROTAT2(lensend),inext,3300+isend,
2701 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2702 c & iprev,3300+irecv,FG_COMM,status,IERR)
2703 c write (iout,*) "Gather ROTAT2"
2705 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2706 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2707 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2708 & iprev,4400+irecv,FG_COMM,status,IERR)
2709 c write (iout,*) "Gather ROTAT_OLD"
2711 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2712 & MPI_PRECOMP11(lensend),inext,5500+isend,
2713 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2714 & iprev,5500+irecv,FG_COMM,status,IERR)
2715 c write (iout,*) "Gather PRECOMP11"
2717 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2718 & MPI_PRECOMP12(lensend),inext,6600+isend,
2719 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2720 & iprev,6600+irecv,FG_COMM,status,IERR)
2721 c write (iout,*) "Gather PRECOMP12"
2723 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2725 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2726 & MPI_ROTAT2(lensend),inext,7700+isend,
2727 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2728 & iprev,7700+irecv,FG_COMM,status,IERR)
2729 c write (iout,*) "Gather PRECOMP21"
2731 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2732 & MPI_PRECOMP22(lensend),inext,8800+isend,
2733 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2734 & iprev,8800+irecv,FG_COMM,status,IERR)
2735 c write (iout,*) "Gather PRECOMP22"
2737 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2738 & MPI_PRECOMP23(lensend),inext,9900+isend,
2739 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2740 & MPI_PRECOMP23(lenrecv),
2741 & iprev,9900+irecv,FG_COMM,status,IERR)
2742 c write (iout,*) "Gather PRECOMP23"
2747 if (irecv.lt.0) irecv=nfgtasks1-1
2750 time_gather=time_gather+MPI_Wtime()-time00
2753 c if (fg_rank.eq.0) then
2754 write (iout,*) "Arrays UG and UGDER"
2756 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2757 & ((ug(l,k,i),l=1,2),k=1,2),
2758 & ((ugder(l,k,i),l=1,2),k=1,2)
2760 write (iout,*) "Arrays UG2 and UG2DER"
2762 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2763 & ((ug2(l,k,i),l=1,2),k=1,2),
2764 & ((ug2der(l,k,i),l=1,2),k=1,2)
2766 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2768 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2769 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2770 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2772 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2774 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2775 & costab(i),sintab(i),costab2(i),sintab2(i)
2777 write (iout,*) "Array MUDER"
2779 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2785 cd iti = itortyp(itype(i))
2788 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2789 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2794 C--------------------------------------------------------------------------
2795 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2797 C This subroutine calculates the average interaction energy and its gradient
2798 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2799 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2800 C The potential depends both on the distance of peptide-group centers and on
2801 C the orientation of the CA-CA virtual bonds.
2803 implicit real*8 (a-h,o-z)
2807 include 'DIMENSIONS'
2808 include 'COMMON.CONTROL'
2809 include 'COMMON.SETUP'
2810 include 'COMMON.IOUNITS'
2811 include 'COMMON.GEO'
2812 include 'COMMON.VAR'
2813 include 'COMMON.LOCAL'
2814 include 'COMMON.CHAIN'
2815 include 'COMMON.DERIV'
2816 include 'COMMON.INTERACT'
2817 include 'COMMON.CONTACTS'
2818 include 'COMMON.TORSION'
2819 include 'COMMON.VECTORS'
2820 include 'COMMON.FFIELD'
2821 include 'COMMON.TIME1'
2822 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2823 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2824 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2825 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2826 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2827 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2829 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2831 double precision scal_el /1.0d0/
2833 double precision scal_el /0.5d0/
2836 C 13-go grudnia roku pamietnego...
2837 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2838 & 0.0d0,1.0d0,0.0d0,
2839 & 0.0d0,0.0d0,1.0d0/
2840 cd write(iout,*) 'In EELEC'
2842 cd write(iout,*) 'Type',i
2843 cd write(iout,*) 'B1',B1(:,i)
2844 cd write(iout,*) 'B2',B2(:,i)
2845 cd write(iout,*) 'CC',CC(:,:,i)
2846 cd write(iout,*) 'DD',DD(:,:,i)
2847 cd write(iout,*) 'EE',EE(:,:,i)
2849 cd call check_vecgrad
2851 if (icheckgrad.eq.1) then
2853 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2855 dc_norm(k,i)=dc(k,i)*fac
2857 c write (iout,*) 'i',i,' fac',fac
2860 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2861 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2862 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2863 c call vec_and_deriv
2869 time_mat=time_mat+MPI_Wtime()-time01
2873 cd write (iout,*) 'i=',i
2875 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2878 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2879 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2892 cd print '(a)','Enter EELEC'
2893 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2895 gel_loc_loc(i)=0.0d0
2900 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2902 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2904 do i=iturn3_start,iturn3_end
2908 dx_normi=dc_norm(1,i)
2909 dy_normi=dc_norm(2,i)
2910 dz_normi=dc_norm(3,i)
2911 xmedi=c(1,i)+0.5d0*dxi
2912 ymedi=c(2,i)+0.5d0*dyi
2913 zmedi=c(3,i)+0.5d0*dzi
2915 call eelecij(i,i+2,ees,evdw1,eel_loc)
2916 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2917 num_cont_hb(i)=num_conti
2919 do i=iturn4_start,iturn4_end
2923 dx_normi=dc_norm(1,i)
2924 dy_normi=dc_norm(2,i)
2925 dz_normi=dc_norm(3,i)
2926 xmedi=c(1,i)+0.5d0*dxi
2927 ymedi=c(2,i)+0.5d0*dyi
2928 zmedi=c(3,i)+0.5d0*dzi
2929 num_conti=num_cont_hb(i)
2930 call eelecij(i,i+3,ees,evdw1,eel_loc)
2931 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
2932 num_cont_hb(i)=num_conti
2935 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2937 do i=iatel_s,iatel_e
2941 dx_normi=dc_norm(1,i)
2942 dy_normi=dc_norm(2,i)
2943 dz_normi=dc_norm(3,i)
2944 xmedi=c(1,i)+0.5d0*dxi
2945 ymedi=c(2,i)+0.5d0*dyi
2946 zmedi=c(3,i)+0.5d0*dzi
2947 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2948 num_conti=num_cont_hb(i)
2949 do j=ielstart(i),ielend(i)
2950 call eelecij(i,j,ees,evdw1,eel_loc)
2952 num_cont_hb(i)=num_conti
2954 c write (iout,*) "Number of loop steps in EELEC:",ind
2956 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2957 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2959 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2960 ccc eel_loc=eel_loc+eello_turn3
2961 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2964 C-------------------------------------------------------------------------------
2965 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2966 implicit real*8 (a-h,o-z)
2967 include 'DIMENSIONS'
2971 include 'COMMON.CONTROL'
2972 include 'COMMON.IOUNITS'
2973 include 'COMMON.GEO'
2974 include 'COMMON.VAR'
2975 include 'COMMON.LOCAL'
2976 include 'COMMON.CHAIN'
2977 include 'COMMON.DERIV'
2978 include 'COMMON.INTERACT'
2979 include 'COMMON.CONTACTS'
2980 include 'COMMON.TORSION'
2981 include 'COMMON.VECTORS'
2982 include 'COMMON.FFIELD'
2983 include 'COMMON.TIME1'
2984 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2985 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2986 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2987 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2988 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2989 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2991 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2993 double precision scal_el /1.0d0/
2995 double precision scal_el /0.5d0/
2998 C 13-go grudnia roku pamietnego...
2999 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3000 & 0.0d0,1.0d0,0.0d0,
3001 & 0.0d0,0.0d0,1.0d0/
3002 c time00=MPI_Wtime()
3003 cd write (iout,*) "eelecij",i,j
3007 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3008 aaa=app(iteli,itelj)
3009 bbb=bpp(iteli,itelj)
3010 ael6i=ael6(iteli,itelj)
3011 ael3i=ael3(iteli,itelj)
3015 dx_normj=dc_norm(1,j)
3016 dy_normj=dc_norm(2,j)
3017 dz_normj=dc_norm(3,j)
3018 xj=c(1,j)+0.5D0*dxj-xmedi
3019 yj=c(2,j)+0.5D0*dyj-ymedi
3020 zj=c(3,j)+0.5D0*dzj-zmedi
3021 rij=xj*xj+yj*yj+zj*zj
3027 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3028 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3029 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3030 fac=cosa-3.0D0*cosb*cosg
3032 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3033 if (j.eq.i+2) ev1=scal_el*ev1
3038 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3041 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3042 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3045 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3046 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3047 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3048 cd & xmedi,ymedi,zmedi,xj,yj,zj
3050 if (energy_dec) then
3051 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3052 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3056 C Calculate contributions to the Cartesian gradient.
3059 facvdw=-6*rrmij*(ev1+evdwij)
3060 facel=-3*rrmij*(el1+eesij)
3066 * Radial derivatives. First process both termini of the fragment (i,j)
3072 c ghalf=0.5D0*ggg(k)
3073 c gelc(k,i)=gelc(k,i)+ghalf
3074 c gelc(k,j)=gelc(k,j)+ghalf
3076 c 9/28/08 AL Gradient compotents will be summed only at the end
3078 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3079 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3082 * Loop over residues i+1 thru j-1.
3086 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3093 c ghalf=0.5D0*ggg(k)
3094 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3095 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3097 c 9/28/08 AL Gradient compotents will be summed only at the end
3099 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3100 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3103 * Loop over residues i+1 thru j-1.
3107 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3114 fac=-3*rrmij*(facvdw+facvdw+facel)
3119 * Radial derivatives. First process both termini of the fragment (i,j)
3125 c ghalf=0.5D0*ggg(k)
3126 c gelc(k,i)=gelc(k,i)+ghalf
3127 c gelc(k,j)=gelc(k,j)+ghalf
3129 c 9/28/08 AL Gradient compotents will be summed only at the end
3131 gelc_long(k,j)=gelc(k,j)+ggg(k)
3132 gelc_long(k,i)=gelc(k,i)-ggg(k)
3135 * Loop over residues i+1 thru j-1.
3139 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3142 c 9/28/08 AL Gradient compotents will be summed only at the end
3147 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3148 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3154 ecosa=2.0D0*fac3*fac1+fac4
3157 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3158 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3160 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3161 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3163 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3164 cd & (dcosg(k),k=1,3)
3166 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3169 c ghalf=0.5D0*ggg(k)
3170 c gelc(k,i)=gelc(k,i)+ghalf
3171 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3172 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3173 c gelc(k,j)=gelc(k,j)+ghalf
3174 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3175 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3179 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3184 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3185 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3187 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3188 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3189 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3190 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3192 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3193 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3194 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3196 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3197 C energy of a peptide unit is assumed in the form of a second-order
3198 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3199 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3200 C are computed for EVERY pair of non-contiguous peptide groups.
3202 if (j.lt.nres-1) then
3213 muij(kkk)=mu(k,i)*mu(l,j)
3216 cd write (iout,*) 'EELEC: i',i,' j',j
3217 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3218 cd write(iout,*) 'muij',muij
3219 ury=scalar(uy(1,i),erij)
3220 urz=scalar(uz(1,i),erij)
3221 vry=scalar(uy(1,j),erij)
3222 vrz=scalar(uz(1,j),erij)
3223 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3224 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3225 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3226 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3227 fac=dsqrt(-ael6i)*r3ij
3232 cd write (iout,'(4i5,4f10.5)')
3233 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3234 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3235 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3236 cd & uy(:,j),uz(:,j)
3237 cd write (iout,'(4f10.5)')
3238 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3239 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3240 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3241 cd write (iout,'(9f10.5/)')
3242 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3243 C Derivatives of the elements of A in virtual-bond vectors
3244 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3246 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3247 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3248 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3249 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3250 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3251 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3252 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3253 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3254 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3255 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3256 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3257 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3259 C Compute radial contributions to the gradient
3277 C Add the contributions coming from er
3280 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3281 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3282 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3283 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3286 C Derivatives in DC(i)
3287 cgrad ghalf1=0.5d0*agg(k,1)
3288 cgrad ghalf2=0.5d0*agg(k,2)
3289 cgrad ghalf3=0.5d0*agg(k,3)
3290 cgrad ghalf4=0.5d0*agg(k,4)
3291 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3292 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3293 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3294 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3295 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3296 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3297 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3298 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3299 C Derivatives in DC(i+1)
3300 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3301 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3302 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3303 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3304 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3305 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3306 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3307 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3308 C Derivatives in DC(j)
3309 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3310 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3311 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3312 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3313 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3314 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3315 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3316 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3317 C Derivatives in DC(j+1) or DC(nres-1)
3318 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3319 & -3.0d0*vryg(k,3)*ury)
3320 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3321 & -3.0d0*vrzg(k,3)*ury)
3322 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3323 & -3.0d0*vryg(k,3)*urz)
3324 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3325 & -3.0d0*vrzg(k,3)*urz)
3326 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3328 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3341 aggi(k,l)=-aggi(k,l)
3342 aggi1(k,l)=-aggi1(k,l)
3343 aggj(k,l)=-aggj(k,l)
3344 aggj1(k,l)=-aggj1(k,l)
3347 if (j.lt.nres-1) then
3353 aggi(k,l)=-aggi(k,l)
3354 aggi1(k,l)=-aggi1(k,l)
3355 aggj(k,l)=-aggj(k,l)
3356 aggj1(k,l)=-aggj1(k,l)
3367 aggi(k,l)=-aggi(k,l)
3368 aggi1(k,l)=-aggi1(k,l)
3369 aggj(k,l)=-aggj(k,l)
3370 aggj1(k,l)=-aggj1(k,l)
3375 IF (wel_loc.gt.0.0d0) THEN
3376 C Contribution to the local-electrostatic energy coming from the i-j pair
3377 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3379 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3381 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3382 & 'eelloc',i,j,eel_loc_ij
3384 eel_loc=eel_loc+eel_loc_ij
3385 C Partial derivatives in virtual-bond dihedral angles gamma
3387 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3388 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3389 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3390 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3391 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3392 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3393 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3395 ggg(l)=agg(l,1)*muij(1)+
3396 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3397 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3398 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3399 cgrad ghalf=0.5d0*ggg(l)
3400 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3401 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3405 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3408 C Remaining derivatives of eello
3410 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3411 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3412 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3413 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3414 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3415 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3416 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3417 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3420 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3421 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3422 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3423 & .and. num_conti.le.maxconts) then
3424 c write (iout,*) i,j," entered corr"
3426 C Calculate the contact function. The ith column of the array JCONT will
3427 C contain the numbers of atoms that make contacts with the atom I (of numbers
3428 C greater than I). The arrays FACONT and GACONT will contain the values of
3429 C the contact function and its derivative.
3430 c r0ij=1.02D0*rpp(iteli,itelj)
3431 c r0ij=1.11D0*rpp(iteli,itelj)
3432 r0ij=2.20D0*rpp(iteli,itelj)
3433 c r0ij=1.55D0*rpp(iteli,itelj)
3434 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3435 if (fcont.gt.0.0D0) then
3436 num_conti=num_conti+1
3437 if (num_conti.gt.maxconts) then
3438 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3439 & ' will skip next contacts for this conf.'
3441 jcont_hb(num_conti,i)=j
3442 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3443 cd & " jcont_hb",jcont_hb(num_conti,i)
3444 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3445 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3446 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3448 d_cont(num_conti,i)=rij
3449 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3450 C --- Electrostatic-interaction matrix ---
3451 a_chuj(1,1,num_conti,i)=a22
3452 a_chuj(1,2,num_conti,i)=a23
3453 a_chuj(2,1,num_conti,i)=a32
3454 a_chuj(2,2,num_conti,i)=a33
3455 C --- Gradient of rij
3457 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3464 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3465 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3466 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3467 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3468 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3473 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3474 C Calculate contact energies
3476 wij=cosa-3.0D0*cosb*cosg
3479 c fac3=dsqrt(-ael6i)/r0ij**3
3480 fac3=dsqrt(-ael6i)*r3ij
3481 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3482 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3483 if (ees0tmp.gt.0) then
3484 ees0pij=dsqrt(ees0tmp)
3488 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3489 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3490 if (ees0tmp.gt.0) then
3491 ees0mij=dsqrt(ees0tmp)
3496 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3497 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3498 C Diagnostics. Comment out or remove after debugging!
3499 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3500 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3501 c ees0m(num_conti,i)=0.0D0
3503 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3504 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3505 C Angular derivatives of the contact function
3506 ees0pij1=fac3/ees0pij
3507 ees0mij1=fac3/ees0mij
3508 fac3p=-3.0D0*fac3*rrmij
3509 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3510 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3512 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3513 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3514 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3515 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3516 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3517 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3518 ecosap=ecosa1+ecosa2
3519 ecosbp=ecosb1+ecosb2
3520 ecosgp=ecosg1+ecosg2
3521 ecosam=ecosa1-ecosa2
3522 ecosbm=ecosb1-ecosb2
3523 ecosgm=ecosg1-ecosg2
3532 facont_hb(num_conti,i)=fcont
3533 fprimcont=fprimcont/rij
3534 cd facont_hb(num_conti,i)=1.0D0
3535 C Following line is for diagnostics.
3538 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3539 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3542 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3543 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3545 gggp(1)=gggp(1)+ees0pijp*xj
3546 gggp(2)=gggp(2)+ees0pijp*yj
3547 gggp(3)=gggp(3)+ees0pijp*zj
3548 gggm(1)=gggm(1)+ees0mijp*xj
3549 gggm(2)=gggm(2)+ees0mijp*yj
3550 gggm(3)=gggm(3)+ees0mijp*zj
3551 C Derivatives due to the contact function
3552 gacont_hbr(1,num_conti,i)=fprimcont*xj
3553 gacont_hbr(2,num_conti,i)=fprimcont*yj
3554 gacont_hbr(3,num_conti,i)=fprimcont*zj
3557 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3558 c following the change of gradient-summation algorithm.
3560 cgrad ghalfp=0.5D0*gggp(k)
3561 cgrad ghalfm=0.5D0*gggm(k)
3562 gacontp_hb1(k,num_conti,i)=!ghalfp
3563 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3564 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3565 gacontp_hb2(k,num_conti,i)=!ghalfp
3566 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3567 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3568 gacontp_hb3(k,num_conti,i)=gggp(k)
3569 gacontm_hb1(k,num_conti,i)=!ghalfm
3570 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3571 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3572 gacontm_hb2(k,num_conti,i)=!ghalfm
3573 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3574 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3575 gacontm_hb3(k,num_conti,i)=gggm(k)
3577 C Diagnostics. Comment out or remove after debugging!
3579 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3580 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3581 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3582 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3583 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3584 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3587 endif ! num_conti.le.maxconts
3590 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3593 ghalf=0.5d0*agg(l,k)
3594 aggi(l,k)=aggi(l,k)+ghalf
3595 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3596 aggj(l,k)=aggj(l,k)+ghalf
3599 if (j.eq.nres-1 .and. i.lt.j-2) then
3602 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3607 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3610 C-----------------------------------------------------------------------------
3611 subroutine eturn3(i,eello_turn3)
3612 C Third- and fourth-order contributions from turns
3613 implicit real*8 (a-h,o-z)
3614 include 'DIMENSIONS'
3615 include 'COMMON.IOUNITS'
3616 include 'COMMON.GEO'
3617 include 'COMMON.VAR'
3618 include 'COMMON.LOCAL'
3619 include 'COMMON.CHAIN'
3620 include 'COMMON.DERIV'
3621 include 'COMMON.INTERACT'
3622 include 'COMMON.CONTACTS'
3623 include 'COMMON.TORSION'
3624 include 'COMMON.VECTORS'
3625 include 'COMMON.FFIELD'
3626 include 'COMMON.CONTROL'
3628 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3629 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3630 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3631 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3632 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3633 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3634 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3637 c write (iout,*) "eturn3",i,j,j1,j2
3642 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3644 C Third-order contributions
3651 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3652 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3653 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3654 call transpose2(auxmat(1,1),auxmat1(1,1))
3655 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3656 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3657 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3658 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3659 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3660 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3661 cd & ' eello_turn3_num',4*eello_turn3_num
3662 C Derivatives in gamma(i)
3663 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3664 call transpose2(auxmat2(1,1),auxmat3(1,1))
3665 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3666 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3667 C Derivatives in gamma(i+1)
3668 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3669 call transpose2(auxmat2(1,1),auxmat3(1,1))
3670 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3671 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3672 & +0.5d0*(pizda(1,1)+pizda(2,2))
3673 C Cartesian derivatives
3675 c ghalf1=0.5d0*agg(l,1)
3676 c ghalf2=0.5d0*agg(l,2)
3677 c ghalf3=0.5d0*agg(l,3)
3678 c ghalf4=0.5d0*agg(l,4)
3679 a_temp(1,1)=aggi(l,1)!+ghalf1
3680 a_temp(1,2)=aggi(l,2)!+ghalf2
3681 a_temp(2,1)=aggi(l,3)!+ghalf3
3682 a_temp(2,2)=aggi(l,4)!+ghalf4
3683 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3684 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3685 & +0.5d0*(pizda(1,1)+pizda(2,2))
3686 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3687 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3688 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3689 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3690 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3691 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3692 & +0.5d0*(pizda(1,1)+pizda(2,2))
3693 a_temp(1,1)=aggj(l,1)!+ghalf1
3694 a_temp(1,2)=aggj(l,2)!+ghalf2
3695 a_temp(2,1)=aggj(l,3)!+ghalf3
3696 a_temp(2,2)=aggj(l,4)!+ghalf4
3697 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3698 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3699 & +0.5d0*(pizda(1,1)+pizda(2,2))
3700 a_temp(1,1)=aggj1(l,1)
3701 a_temp(1,2)=aggj1(l,2)
3702 a_temp(2,1)=aggj1(l,3)
3703 a_temp(2,2)=aggj1(l,4)
3704 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3705 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3706 & +0.5d0*(pizda(1,1)+pizda(2,2))
3710 C-------------------------------------------------------------------------------
3711 subroutine eturn4(i,eello_turn4)
3712 C Third- and fourth-order contributions from turns
3713 implicit real*8 (a-h,o-z)
3714 include 'DIMENSIONS'
3715 include 'COMMON.IOUNITS'
3716 include 'COMMON.GEO'
3717 include 'COMMON.VAR'
3718 include 'COMMON.LOCAL'
3719 include 'COMMON.CHAIN'
3720 include 'COMMON.DERIV'
3721 include 'COMMON.INTERACT'
3722 include 'COMMON.CONTACTS'
3723 include 'COMMON.TORSION'
3724 include 'COMMON.VECTORS'
3725 include 'COMMON.FFIELD'
3726 include 'COMMON.CONTROL'
3728 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3729 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3730 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3731 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3732 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3733 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3734 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3737 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3739 C Fourth-order contributions
3747 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3748 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3749 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3754 iti1=itortyp(itype(i+1))
3755 iti2=itortyp(itype(i+2))
3756 iti3=itortyp(itype(i+3))
3757 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3758 call transpose2(EUg(1,1,i+1),e1t(1,1))
3759 call transpose2(Eug(1,1,i+2),e2t(1,1))
3760 call transpose2(Eug(1,1,i+3),e3t(1,1))
3761 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3762 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3763 s1=scalar2(b1(1,iti2),auxvec(1))
3764 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3765 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3766 s2=scalar2(b1(1,iti1),auxvec(1))
3767 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3768 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3769 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3770 eello_turn4=eello_turn4-(s1+s2+s3)
3771 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3772 & 'eturn4',i,j,-(s1+s2+s3)
3773 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3774 cd & ' eello_turn4_num',8*eello_turn4_num
3775 C Derivatives in gamma(i)
3776 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3777 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3778 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3779 s1=scalar2(b1(1,iti2),auxvec(1))
3780 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3781 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3782 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3783 C Derivatives in gamma(i+1)
3784 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3785 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3786 s2=scalar2(b1(1,iti1),auxvec(1))
3787 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3788 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3789 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3790 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3791 C Derivatives in gamma(i+2)
3792 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3793 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3794 s1=scalar2(b1(1,iti2),auxvec(1))
3795 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3796 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3797 s2=scalar2(b1(1,iti1),auxvec(1))
3798 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3799 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3800 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3801 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3802 C Cartesian derivatives
3803 C Derivatives of this turn contributions in DC(i+2)
3804 if (j.lt.nres-1) then
3806 a_temp(1,1)=agg(l,1)
3807 a_temp(1,2)=agg(l,2)
3808 a_temp(2,1)=agg(l,3)
3809 a_temp(2,2)=agg(l,4)
3810 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3811 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3812 s1=scalar2(b1(1,iti2),auxvec(1))
3813 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3814 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3815 s2=scalar2(b1(1,iti1),auxvec(1))
3816 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3817 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3818 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3820 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3823 C Remaining derivatives of this turn contribution
3825 a_temp(1,1)=aggi(l,1)
3826 a_temp(1,2)=aggi(l,2)
3827 a_temp(2,1)=aggi(l,3)
3828 a_temp(2,2)=aggi(l,4)
3829 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3830 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3831 s1=scalar2(b1(1,iti2),auxvec(1))
3832 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3833 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3834 s2=scalar2(b1(1,iti1),auxvec(1))
3835 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3836 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3837 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3838 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3839 a_temp(1,1)=aggi1(l,1)
3840 a_temp(1,2)=aggi1(l,2)
3841 a_temp(2,1)=aggi1(l,3)
3842 a_temp(2,2)=aggi1(l,4)
3843 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3844 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3845 s1=scalar2(b1(1,iti2),auxvec(1))
3846 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3847 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3848 s2=scalar2(b1(1,iti1),auxvec(1))
3849 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3850 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3851 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3852 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3853 a_temp(1,1)=aggj(l,1)
3854 a_temp(1,2)=aggj(l,2)
3855 a_temp(2,1)=aggj(l,3)
3856 a_temp(2,2)=aggj(l,4)
3857 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3858 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3859 s1=scalar2(b1(1,iti2),auxvec(1))
3860 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3861 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3862 s2=scalar2(b1(1,iti1),auxvec(1))
3863 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3864 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3865 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3866 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3867 a_temp(1,1)=aggj1(l,1)
3868 a_temp(1,2)=aggj1(l,2)
3869 a_temp(2,1)=aggj1(l,3)
3870 a_temp(2,2)=aggj1(l,4)
3871 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3872 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3873 s1=scalar2(b1(1,iti2),auxvec(1))
3874 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3875 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3876 s2=scalar2(b1(1,iti1),auxvec(1))
3877 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3878 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3879 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3880 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3881 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3885 C-----------------------------------------------------------------------------
3886 subroutine vecpr(u,v,w)
3887 implicit real*8(a-h,o-z)
3888 dimension u(3),v(3),w(3)
3889 w(1)=u(2)*v(3)-u(3)*v(2)
3890 w(2)=-u(1)*v(3)+u(3)*v(1)
3891 w(3)=u(1)*v(2)-u(2)*v(1)
3894 C-----------------------------------------------------------------------------
3895 subroutine unormderiv(u,ugrad,unorm,ungrad)
3896 C This subroutine computes the derivatives of a normalized vector u, given
3897 C the derivatives computed without normalization conditions, ugrad. Returns
3900 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3901 double precision vec(3)
3902 double precision scalar
3904 c write (2,*) 'ugrad',ugrad
3907 vec(i)=scalar(ugrad(1,i),u(1))
3909 c write (2,*) 'vec',vec
3912 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3915 c write (2,*) 'ungrad',ungrad
3918 C-----------------------------------------------------------------------------
3919 subroutine escp_soft_sphere(evdw2,evdw2_14)
3921 C This subroutine calculates the excluded-volume interaction energy between
3922 C peptide-group centers and side chains and its gradient in virtual-bond and
3923 C side-chain vectors.
3925 implicit real*8 (a-h,o-z)
3926 include 'DIMENSIONS'
3927 include 'COMMON.GEO'
3928 include 'COMMON.VAR'
3929 include 'COMMON.LOCAL'
3930 include 'COMMON.CHAIN'
3931 include 'COMMON.DERIV'
3932 include 'COMMON.INTERACT'
3933 include 'COMMON.FFIELD'
3934 include 'COMMON.IOUNITS'
3935 include 'COMMON.CONTROL'
3940 cd print '(a)','Enter ESCP'
3941 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3942 do i=iatscp_s,iatscp_e
3944 xi=0.5D0*(c(1,i)+c(1,i+1))
3945 yi=0.5D0*(c(2,i)+c(2,i+1))
3946 zi=0.5D0*(c(3,i)+c(3,i+1))
3948 do iint=1,nscp_gr(i)
3950 do j=iscpstart(i,iint),iscpend(i,iint)
3952 C Uncomment following three lines for SC-p interactions
3956 C Uncomment following three lines for Ca-p interactions
3960 rij=xj*xj+yj*yj+zj*zj
3963 if (rij.lt.r0ijsq) then
3964 evdwij=0.25d0*(rij-r0ijsq)**2
3972 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3977 cgrad if (j.lt.i) then
3978 cd write (iout,*) 'j<i'
3979 C Uncomment following three lines for SC-p interactions
3981 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3984 cd write (iout,*) 'j>i'
3986 cgrad ggg(k)=-ggg(k)
3987 C Uncomment following line for SC-p interactions
3988 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3992 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3994 cgrad kstart=min0(i+1,j)
3995 cgrad kend=max0(i-1,j-1)
3996 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3997 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3998 cgrad do k=kstart,kend
4000 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4004 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4005 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4013 C-----------------------------------------------------------------------------
4014 subroutine escp(evdw2,evdw2_14)
4016 C This subroutine calculates the excluded-volume interaction energy between
4017 C peptide-group centers and side chains and its gradient in virtual-bond and
4018 C side-chain vectors.
4020 implicit real*8 (a-h,o-z)
4021 include 'DIMENSIONS'
4022 include 'COMMON.GEO'
4023 include 'COMMON.VAR'
4024 include 'COMMON.LOCAL'
4025 include 'COMMON.CHAIN'
4026 include 'COMMON.DERIV'
4027 include 'COMMON.INTERACT'
4028 include 'COMMON.FFIELD'
4029 include 'COMMON.IOUNITS'
4030 include 'COMMON.CONTROL'
4034 cd print '(a)','Enter ESCP'
4035 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4036 do i=iatscp_s,iatscp_e
4038 xi=0.5D0*(c(1,i)+c(1,i+1))
4039 yi=0.5D0*(c(2,i)+c(2,i+1))
4040 zi=0.5D0*(c(3,i)+c(3,i+1))
4042 do iint=1,nscp_gr(i)
4044 do j=iscpstart(i,iint),iscpend(i,iint)
4046 C Uncomment following three lines for SC-p interactions
4050 C Uncomment following three lines for Ca-p interactions
4054 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4056 e1=fac*fac*aad(itypj,iteli)
4057 e2=fac*bad(itypj,iteli)
4058 if (iabs(j-i) .le. 2) then
4061 evdw2_14=evdw2_14+e1+e2
4065 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4066 & 'evdw2',i,j,evdwij
4068 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4070 fac=-(evdwij+e1)*rrij
4074 cgrad if (j.lt.i) then
4075 cd write (iout,*) 'j<i'
4076 C Uncomment following three lines for SC-p interactions
4078 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4081 cd write (iout,*) 'j>i'
4083 cgrad ggg(k)=-ggg(k)
4084 C Uncomment following line for SC-p interactions
4085 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4086 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4090 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4092 cgrad kstart=min0(i+1,j)
4093 cgrad kend=max0(i-1,j-1)
4094 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4095 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4096 cgrad do k=kstart,kend
4098 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4102 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4103 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4111 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4112 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4113 gradx_scp(j,i)=expon*gradx_scp(j,i)
4116 C******************************************************************************
4120 C To save time the factor EXPON has been extracted from ALL components
4121 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4124 C******************************************************************************
4127 C--------------------------------------------------------------------------
4128 subroutine edis(ehpb)
4130 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4132 implicit real*8 (a-h,o-z)
4133 include 'DIMENSIONS'
4134 include 'COMMON.SBRIDGE'
4135 include 'COMMON.CHAIN'
4136 include 'COMMON.DERIV'
4137 include 'COMMON.VAR'
4138 include 'COMMON.INTERACT'
4139 include 'COMMON.IOUNITS'
4142 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4143 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4144 if (link_end.eq.0) return
4145 do i=link_start,link_end
4146 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4147 C CA-CA distance used in regularization of structure.
4150 C iii and jjj point to the residues for which the distance is assigned.
4151 if (ii.gt.nres) then
4158 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4159 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4160 C distance and angle dependent SS bond potential.
4161 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4162 call ssbond_ene(iii,jjj,eij)
4164 cd write (iout,*) "eij",eij
4166 C Calculate the distance between the two points and its difference from the
4170 C Get the force constant corresponding to this distance.
4172 C Calculate the contribution to energy.
4173 ehpb=ehpb+waga*rdis*rdis
4175 C Evaluate gradient.
4178 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4179 cd & ' waga=',waga,' fac=',fac
4181 ggg(j)=fac*(c(j,jj)-c(j,ii))
4183 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4184 C If this is a SC-SC distance, we need to calculate the contributions to the
4185 C Cartesian gradient in the SC vectors (ghpbx).
4188 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4189 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4192 cgrad do j=iii,jjj-1
4194 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4198 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4199 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4206 C--------------------------------------------------------------------------
4207 subroutine ssbond_ene(i,j,eij)
4209 C Calculate the distance and angle dependent SS-bond potential energy
4210 C using a free-energy function derived based on RHF/6-31G** ab initio
4211 C calculations of diethyl disulfide.
4213 C A. Liwo and U. Kozlowska, 11/24/03
4215 implicit real*8 (a-h,o-z)
4216 include 'DIMENSIONS'
4217 include 'COMMON.SBRIDGE'
4218 include 'COMMON.CHAIN'
4219 include 'COMMON.DERIV'
4220 include 'COMMON.LOCAL'
4221 include 'COMMON.INTERACT'
4222 include 'COMMON.VAR'
4223 include 'COMMON.IOUNITS'
4224 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4229 dxi=dc_norm(1,nres+i)
4230 dyi=dc_norm(2,nres+i)
4231 dzi=dc_norm(3,nres+i)
4232 c dsci_inv=dsc_inv(itypi)
4233 dsci_inv=vbld_inv(nres+i)
4235 c dscj_inv=dsc_inv(itypj)
4236 dscj_inv=vbld_inv(nres+j)
4240 dxj=dc_norm(1,nres+j)
4241 dyj=dc_norm(2,nres+j)
4242 dzj=dc_norm(3,nres+j)
4243 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4248 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4249 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4250 om12=dxi*dxj+dyi*dyj+dzi*dzj
4252 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4253 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4259 deltat12=om2-om1+2.0d0
4261 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4262 & +akct*deltad*deltat12
4263 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4264 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4265 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4266 c & " deltat12",deltat12," eij",eij
4267 ed=2*akcm*deltad+akct*deltat12
4269 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4270 eom1=-2*akth*deltat1-pom1-om2*pom2
4271 eom2= 2*akth*deltat2+pom1-om1*pom2
4274 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4275 ghpbx(k,i)=ghpbx(k,i)-ggk
4276 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4277 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4278 ghpbx(k,j)=ghpbx(k,j)+ggk
4279 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4280 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4281 ghpbc(k,i)=ghpbc(k,i)-ggk
4282 ghpbc(k,j)=ghpbc(k,j)+ggk
4285 C Calculate the components of the gradient in DC and X
4289 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4294 C--------------------------------------------------------------------------
4295 subroutine ebond(estr)
4297 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4299 implicit real*8 (a-h,o-z)
4300 include 'DIMENSIONS'
4301 include 'COMMON.LOCAL'
4302 include 'COMMON.GEO'
4303 include 'COMMON.INTERACT'
4304 include 'COMMON.DERIV'
4305 include 'COMMON.VAR'
4306 include 'COMMON.CHAIN'
4307 include 'COMMON.IOUNITS'
4308 include 'COMMON.NAMES'
4309 include 'COMMON.FFIELD'
4310 include 'COMMON.CONTROL'
4311 include 'COMMON.SETUP'
4312 double precision u(3),ud(3)
4314 do i=ibondp_start,ibondp_end
4315 diff = vbld(i)-vbldp0
4316 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4319 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4321 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4325 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4327 do i=ibond_start,ibond_end
4332 diff=vbld(i+nres)-vbldsc0(1,iti)
4333 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4334 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4335 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4337 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4341 diff=vbld(i+nres)-vbldsc0(j,iti)
4342 ud(j)=aksc(j,iti)*diff
4343 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4357 uprod2=uprod2*u(k)*u(k)
4361 usumsqder=usumsqder+ud(j)*uprod2
4363 estr=estr+uprod/usum
4365 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4373 C--------------------------------------------------------------------------
4374 subroutine ebend(etheta)
4376 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4377 C angles gamma and its derivatives in consecutive thetas and gammas.
4379 implicit real*8 (a-h,o-z)
4380 include 'DIMENSIONS'
4381 include 'COMMON.LOCAL'
4382 include 'COMMON.GEO'
4383 include 'COMMON.INTERACT'
4384 include 'COMMON.DERIV'
4385 include 'COMMON.VAR'
4386 include 'COMMON.CHAIN'
4387 include 'COMMON.IOUNITS'
4388 include 'COMMON.NAMES'
4389 include 'COMMON.FFIELD'
4390 include 'COMMON.CONTROL'
4391 common /calcthet/ term1,term2,termm,diffak,ratak,
4392 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4393 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4394 double precision y(2),z(2)
4396 c time11=dexp(-2*time)
4399 c write (*,'(a,i2)') 'EBEND ICG=',icg
4400 do i=ithet_start,ithet_end
4401 C Zero the energy function and its derivative at 0 or pi.
4402 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4407 if (phii.ne.phii) phii=150.0
4420 if (phii1.ne.phii1) phii1=150.0
4432 C Calculate the "mean" value of theta from the part of the distribution
4433 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4434 C In following comments this theta will be referred to as t_c.
4435 thet_pred_mean=0.0d0
4439 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4441 dthett=thet_pred_mean*ssd
4442 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4443 C Derivatives of the "mean" values in gamma1 and gamma2.
4444 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4445 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4446 if (theta(i).gt.pi-delta) then
4447 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4449 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4450 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4451 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4453 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4455 else if (theta(i).lt.delta) then
4456 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4457 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4458 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4460 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4461 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4464 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4467 etheta=etheta+ethetai
4468 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4470 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4471 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4472 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4474 C Ufff.... We've done all this!!!
4477 C---------------------------------------------------------------------------
4478 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4480 implicit real*8 (a-h,o-z)
4481 include 'DIMENSIONS'
4482 include 'COMMON.LOCAL'
4483 include 'COMMON.IOUNITS'
4484 common /calcthet/ term1,term2,termm,diffak,ratak,
4485 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4486 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4487 C Calculate the contributions to both Gaussian lobes.
4488 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4489 C The "polynomial part" of the "standard deviation" of this part of
4493 sig=sig*thet_pred_mean+polthet(j,it)
4495 C Derivative of the "interior part" of the "standard deviation of the"
4496 C gamma-dependent Gaussian lobe in t_c.
4497 sigtc=3*polthet(3,it)
4499 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4502 C Set the parameters of both Gaussian lobes of the distribution.
4503 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4504 fac=sig*sig+sigc0(it)
4507 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4508 sigsqtc=-4.0D0*sigcsq*sigtc
4509 c print *,i,sig,sigtc,sigsqtc
4510 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4511 sigtc=-sigtc/(fac*fac)
4512 C Following variable is sigma(t_c)**(-2)
4513 sigcsq=sigcsq*sigcsq
4515 sig0inv=1.0D0/sig0i**2
4516 delthec=thetai-thet_pred_mean
4517 delthe0=thetai-theta0i
4518 term1=-0.5D0*sigcsq*delthec*delthec
4519 term2=-0.5D0*sig0inv*delthe0*delthe0
4520 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4521 C NaNs in taking the logarithm. We extract the largest exponent which is added
4522 C to the energy (this being the log of the distribution) at the end of energy
4523 C term evaluation for this virtual-bond angle.
4524 if (term1.gt.term2) then
4526 term2=dexp(term2-termm)
4530 term1=dexp(term1-termm)
4533 C The ratio between the gamma-independent and gamma-dependent lobes of
4534 C the distribution is a Gaussian function of thet_pred_mean too.
4535 diffak=gthet(2,it)-thet_pred_mean
4536 ratak=diffak/gthet(3,it)**2
4537 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4538 C Let's differentiate it in thet_pred_mean NOW.
4540 C Now put together the distribution terms to make complete distribution.
4541 termexp=term1+ak*term2
4542 termpre=sigc+ak*sig0i
4543 C Contribution of the bending energy from this theta is just the -log of
4544 C the sum of the contributions from the two lobes and the pre-exponential
4545 C factor. Simple enough, isn't it?
4546 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4547 C NOW the derivatives!!!
4548 C 6/6/97 Take into account the deformation.
4549 E_theta=(delthec*sigcsq*term1
4550 & +ak*delthe0*sig0inv*term2)/termexp
4551 E_tc=((sigtc+aktc*sig0i)/termpre
4552 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4553 & aktc*term2)/termexp)
4556 c-----------------------------------------------------------------------------
4557 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4558 implicit real*8 (a-h,o-z)
4559 include 'DIMENSIONS'
4560 include 'COMMON.LOCAL'
4561 include 'COMMON.IOUNITS'
4562 common /calcthet/ term1,term2,termm,diffak,ratak,
4563 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4564 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4565 delthec=thetai-thet_pred_mean
4566 delthe0=thetai-theta0i
4567 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4568 t3 = thetai-thet_pred_mean
4572 t14 = t12+t6*sigsqtc
4574 t21 = thetai-theta0i
4580 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4581 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4582 & *(-t12*t9-ak*sig0inv*t27)
4586 C--------------------------------------------------------------------------
4587 subroutine ebend(etheta)
4589 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4590 C angles gamma and its derivatives in consecutive thetas and gammas.
4591 C ab initio-derived potentials from
4592 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4594 implicit real*8 (a-h,o-z)
4595 include 'DIMENSIONS'
4596 include 'COMMON.LOCAL'
4597 include 'COMMON.GEO'
4598 include 'COMMON.INTERACT'
4599 include 'COMMON.DERIV'
4600 include 'COMMON.VAR'
4601 include 'COMMON.CHAIN'
4602 include 'COMMON.IOUNITS'
4603 include 'COMMON.NAMES'
4604 include 'COMMON.FFIELD'
4605 include 'COMMON.CONTROL'
4606 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4607 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4608 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4609 & sinph1ph2(maxdouble,maxdouble)
4610 logical lprn /.false./, lprn1 /.false./
4612 do i=ithet_start,ithet_end
4616 theti2=0.5d0*theta(i)
4617 ityp2=ithetyp(itype(i-1))
4619 coskt(k)=dcos(k*theti2)
4620 sinkt(k)=dsin(k*theti2)
4625 if (phii.ne.phii) phii=150.0
4629 ityp1=ithetyp(itype(i-2))
4631 cosph1(k)=dcos(k*phii)
4632 sinph1(k)=dsin(k*phii)
4645 if (phii1.ne.phii1) phii1=150.0
4650 ityp3=ithetyp(itype(i))
4652 cosph2(k)=dcos(k*phii1)
4653 sinph2(k)=dsin(k*phii1)
4663 ethetai=aa0thet(ityp1,ityp2,ityp3)
4666 ccl=cosph1(l)*cosph2(k-l)
4667 ssl=sinph1(l)*sinph2(k-l)
4668 scl=sinph1(l)*cosph2(k-l)
4669 csl=cosph1(l)*sinph2(k-l)
4670 cosph1ph2(l,k)=ccl-ssl
4671 cosph1ph2(k,l)=ccl+ssl
4672 sinph1ph2(l,k)=scl+csl
4673 sinph1ph2(k,l)=scl-csl
4677 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4678 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4679 write (iout,*) "coskt and sinkt"
4681 write (iout,*) k,coskt(k),sinkt(k)
4685 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4686 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4689 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4690 & " ethetai",ethetai
4693 write (iout,*) "cosph and sinph"
4695 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4697 write (iout,*) "cosph1ph2 and sinph2ph2"
4700 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4701 & sinph1ph2(l,k),sinph1ph2(k,l)
4704 write(iout,*) "ethetai",ethetai
4708 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4709 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4710 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4711 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4712 ethetai=ethetai+sinkt(m)*aux
4713 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4714 dephii=dephii+k*sinkt(m)*(
4715 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4716 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4717 dephii1=dephii1+k*sinkt(m)*(
4718 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4719 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4721 & write (iout,*) "m",m," k",k," bbthet",
4722 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4723 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4724 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4725 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4729 & write(iout,*) "ethetai",ethetai
4733 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4734 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4735 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4736 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4737 ethetai=ethetai+sinkt(m)*aux
4738 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4739 dephii=dephii+l*sinkt(m)*(
4740 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4741 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4742 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4743 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4744 dephii1=dephii1+(k-l)*sinkt(m)*(
4745 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4746 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4747 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4748 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4750 write (iout,*) "m",m," k",k," l",l," ffthet",
4751 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4752 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4753 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4754 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4755 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4756 & cosph1ph2(k,l)*sinkt(m),
4757 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4763 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4764 & i,theta(i)*rad2deg,phii*rad2deg,
4765 & phii1*rad2deg,ethetai
4766 etheta=etheta+ethetai
4767 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4768 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4769 gloc(nphi+i-2,icg)=wang*dethetai
4775 c-----------------------------------------------------------------------------
4776 subroutine esc(escloc)
4777 C Calculate the local energy of a side chain and its derivatives in the
4778 C corresponding virtual-bond valence angles THETA and the spherical angles
4780 implicit real*8 (a-h,o-z)
4781 include 'DIMENSIONS'
4782 include 'COMMON.GEO'
4783 include 'COMMON.LOCAL'
4784 include 'COMMON.VAR'
4785 include 'COMMON.INTERACT'
4786 include 'COMMON.DERIV'
4787 include 'COMMON.CHAIN'
4788 include 'COMMON.IOUNITS'
4789 include 'COMMON.NAMES'
4790 include 'COMMON.FFIELD'
4791 include 'COMMON.CONTROL'
4792 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4793 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4794 common /sccalc/ time11,time12,time112,theti,it,nlobit
4797 c write (iout,'(a)') 'ESC'
4798 do i=loc_start,loc_end
4800 if (it.eq.10) goto 1
4802 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4803 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4804 theti=theta(i+1)-pipol
4809 if (x(2).gt.pi-delta) then
4813 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4815 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4816 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4818 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4819 & ddersc0(1),dersc(1))
4820 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4821 & ddersc0(3),dersc(3))
4823 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4825 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4826 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4827 & dersc0(2),esclocbi,dersc02)
4828 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4830 call splinthet(x(2),0.5d0*delta,ss,ssd)
4835 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4837 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4838 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4840 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4842 c write (iout,*) escloci
4843 else if (x(2).lt.delta) then
4847 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4849 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4850 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4852 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4853 & ddersc0(1),dersc(1))
4854 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4855 & ddersc0(3),dersc(3))
4857 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4859 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4860 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4861 & dersc0(2),esclocbi,dersc02)
4862 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4867 call splinthet(x(2),0.5d0*delta,ss,ssd)
4869 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4871 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4872 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4874 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4875 c write (iout,*) escloci
4877 call enesc(x,escloci,dersc,ddummy,.false.)
4880 escloc=escloc+escloci
4881 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4882 & 'escloc',i,escloci
4883 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4885 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4887 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4888 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4893 C---------------------------------------------------------------------------
4894 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4895 implicit real*8 (a-h,o-z)
4896 include 'DIMENSIONS'
4897 include 'COMMON.GEO'
4898 include 'COMMON.LOCAL'
4899 include 'COMMON.IOUNITS'
4900 common /sccalc/ time11,time12,time112,theti,it,nlobit
4901 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4902 double precision contr(maxlob,-1:1)
4904 c write (iout,*) 'it=',it,' nlobit=',nlobit
4908 if (mixed) ddersc(j)=0.0d0
4912 C Because of periodicity of the dependence of the SC energy in omega we have
4913 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4914 C To avoid underflows, first compute & store the exponents.
4922 z(k)=x(k)-censc(k,j,it)
4927 Axk=Axk+gaussc(l,k,j,it)*z(l)
4933 expfac=expfac+Ax(k,j,iii)*z(k)
4941 C As in the case of ebend, we want to avoid underflows in exponentiation and
4942 C subsequent NaNs and INFs in energy calculation.
4943 C Find the largest exponent
4947 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4951 cd print *,'it=',it,' emin=',emin
4953 C Compute the contribution to SC energy and derivatives
4958 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4959 if(adexp.ne.adexp) adexp=1.0
4962 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4964 cd print *,'j=',j,' expfac=',expfac
4965 escloc_i=escloc_i+expfac
4967 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4971 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4972 & +gaussc(k,2,j,it))*expfac
4979 dersc(1)=dersc(1)/cos(theti)**2
4980 ddersc(1)=ddersc(1)/cos(theti)**2
4983 escloci=-(dlog(escloc_i)-emin)
4985 dersc(j)=dersc(j)/escloc_i
4989 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4994 C------------------------------------------------------------------------------
4995 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4996 implicit real*8 (a-h,o-z)
4997 include 'DIMENSIONS'
4998 include 'COMMON.GEO'
4999 include 'COMMON.LOCAL'
5000 include 'COMMON.IOUNITS'
5001 common /sccalc/ time11,time12,time112,theti,it,nlobit
5002 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5003 double precision contr(maxlob)
5014 z(k)=x(k)-censc(k,j,it)
5020 Axk=Axk+gaussc(l,k,j,it)*z(l)
5026 expfac=expfac+Ax(k,j)*z(k)
5031 C As in the case of ebend, we want to avoid underflows in exponentiation and
5032 C subsequent NaNs and INFs in energy calculation.
5033 C Find the largest exponent
5036 if (emin.gt.contr(j)) emin=contr(j)
5040 C Compute the contribution to SC energy and derivatives
5044 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5045 escloc_i=escloc_i+expfac
5047 dersc(k)=dersc(k)+Ax(k,j)*expfac
5049 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5050 & +gaussc(1,2,j,it))*expfac
5054 dersc(1)=dersc(1)/cos(theti)**2
5055 dersc12=dersc12/cos(theti)**2
5056 escloci=-(dlog(escloc_i)-emin)
5058 dersc(j)=dersc(j)/escloc_i
5060 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5064 c----------------------------------------------------------------------------------
5065 subroutine esc(escloc)
5066 C Calculate the local energy of a side chain and its derivatives in the
5067 C corresponding virtual-bond valence angles THETA and the spherical angles
5068 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5069 C added by Urszula Kozlowska. 07/11/2007
5071 implicit real*8 (a-h,o-z)
5072 include 'DIMENSIONS'
5073 include 'COMMON.GEO'
5074 include 'COMMON.LOCAL'
5075 include 'COMMON.VAR'
5076 include 'COMMON.SCROT'
5077 include 'COMMON.INTERACT'
5078 include 'COMMON.DERIV'
5079 include 'COMMON.CHAIN'
5080 include 'COMMON.IOUNITS'
5081 include 'COMMON.NAMES'
5082 include 'COMMON.FFIELD'
5083 include 'COMMON.CONTROL'
5084 include 'COMMON.VECTORS'
5085 double precision x_prime(3),y_prime(3),z_prime(3)
5086 & , sumene,dsc_i,dp2_i,x(65),
5087 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5088 & de_dxx,de_dyy,de_dzz,de_dt
5089 double precision s1_t,s1_6_t,s2_t,s2_6_t
5091 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5092 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5093 & dt_dCi(3),dt_dCi1(3)
5094 common /sccalc/ time11,time12,time112,theti,it,nlobit
5097 do i=loc_start,loc_end
5098 costtab(i+1) =dcos(theta(i+1))
5099 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5100 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5101 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5102 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5103 cosfac=dsqrt(cosfac2)
5104 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5105 sinfac=dsqrt(sinfac2)
5107 if (it.eq.10) goto 1
5109 C Compute the axes of tghe local cartesian coordinates system; store in
5110 c x_prime, y_prime and z_prime
5117 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5118 C & dc_norm(3,i+nres)
5120 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5121 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5124 z_prime(j) = -uz(j,i-1)
5127 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5128 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5129 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5130 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5131 c & " xy",scalar(x_prime(1),y_prime(1)),
5132 c & " xz",scalar(x_prime(1),z_prime(1)),
5133 c & " yy",scalar(y_prime(1),y_prime(1)),
5134 c & " yz",scalar(y_prime(1),z_prime(1)),
5135 c & " zz",scalar(z_prime(1),z_prime(1))
5137 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5138 C to local coordinate system. Store in xx, yy, zz.
5144 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5145 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5146 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5153 C Compute the energy of the ith side cbain
5155 c write (2,*) "xx",xx," yy",yy," zz",zz
5158 x(j) = sc_parmin(j,it)
5161 Cc diagnostics - remove later
5163 yy1 = dsin(alph(2))*dcos(omeg(2))
5164 zz1 = -dsin(alph(2))*dsin(omeg(2))
5165 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5166 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5168 C," --- ", xx_w,yy_w,zz_w
5171 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5172 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5174 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5175 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5177 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5178 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5179 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5180 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5181 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5183 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5184 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5185 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5186 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5187 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5189 dsc_i = 0.743d0+x(61)
5191 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5192 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5193 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5194 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5195 s1=(1+x(63))/(0.1d0 + dscp1)
5196 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5197 s2=(1+x(65))/(0.1d0 + dscp2)
5198 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5199 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5200 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5201 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5203 c & dscp1,dscp2,sumene
5204 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5205 escloc = escloc + sumene
5206 c write (2,*) "i",i," escloc",sumene,escloc
5209 C This section to check the numerical derivatives of the energy of ith side
5210 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5211 C #define DEBUG in the code to turn it on.
5213 write (2,*) "sumene =",sumene
5217 write (2,*) xx,yy,zz
5218 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5219 de_dxx_num=(sumenep-sumene)/aincr
5221 write (2,*) "xx+ sumene from enesc=",sumenep
5224 write (2,*) xx,yy,zz
5225 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5226 de_dyy_num=(sumenep-sumene)/aincr
5228 write (2,*) "yy+ sumene from enesc=",sumenep
5231 write (2,*) xx,yy,zz
5232 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5233 de_dzz_num=(sumenep-sumene)/aincr
5235 write (2,*) "zz+ sumene from enesc=",sumenep
5236 costsave=cost2tab(i+1)
5237 sintsave=sint2tab(i+1)
5238 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5239 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5240 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5241 de_dt_num=(sumenep-sumene)/aincr
5242 write (2,*) " t+ sumene from enesc=",sumenep
5243 cost2tab(i+1)=costsave
5244 sint2tab(i+1)=sintsave
5245 C End of diagnostics section.
5248 C Compute the gradient of esc
5250 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5251 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5252 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5253 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5254 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5255 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5256 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5257 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5258 pom1=(sumene3*sint2tab(i+1)+sumene1)
5259 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5260 pom2=(sumene4*cost2tab(i+1)+sumene2)
5261 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5262 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5263 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5264 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5266 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5267 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5268 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5270 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5271 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5272 & +(pom1+pom2)*pom_dx
5274 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5277 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5278 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5279 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5281 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5282 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5283 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5284 & +x(59)*zz**2 +x(60)*xx*zz
5285 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5286 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5287 & +(pom1-pom2)*pom_dy
5289 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5292 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5293 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5294 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5295 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5296 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5297 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5298 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5299 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5301 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5304 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5305 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5306 & +pom1*pom_dt1+pom2*pom_dt2
5308 write(2,*), "de_dt = ", de_dt,de_dt_num
5312 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5313 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5314 cosfac2xx=cosfac2*xx
5315 sinfac2yy=sinfac2*yy
5317 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5319 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5321 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5322 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5323 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5324 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5325 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5326 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5327 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5328 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5329 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5330 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5334 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5335 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5338 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5339 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5340 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5342 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5343 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5347 dXX_Ctab(k,i)=dXX_Ci(k)
5348 dXX_C1tab(k,i)=dXX_Ci1(k)
5349 dYY_Ctab(k,i)=dYY_Ci(k)
5350 dYY_C1tab(k,i)=dYY_Ci1(k)
5351 dZZ_Ctab(k,i)=dZZ_Ci(k)
5352 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5353 dXX_XYZtab(k,i)=dXX_XYZ(k)
5354 dYY_XYZtab(k,i)=dYY_XYZ(k)
5355 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5359 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5360 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5361 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5362 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5363 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5365 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5366 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5367 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5368 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5369 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5370 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5371 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5372 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5374 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5375 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5377 C to check gradient call subroutine check_grad
5383 c------------------------------------------------------------------------------
5384 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5386 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5387 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5388 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5389 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5391 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5392 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5394 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5395 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5396 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5397 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5398 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5400 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5401 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5402 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5403 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5404 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5406 dsc_i = 0.743d0+x(61)
5408 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5409 & *(xx*cost2+yy*sint2))
5410 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5411 & *(xx*cost2-yy*sint2))
5412 s1=(1+x(63))/(0.1d0 + dscp1)
5413 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5414 s2=(1+x(65))/(0.1d0 + dscp2)
5415 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5416 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5417 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5422 c------------------------------------------------------------------------------
5423 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5425 C This procedure calculates two-body contact function g(rij) and its derivative:
5428 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5431 C where x=(rij-r0ij)/delta
5433 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5436 double precision rij,r0ij,eps0ij,fcont,fprimcont
5437 double precision x,x2,x4,delta
5441 if (x.lt.-1.0D0) then
5444 else if (x.le.1.0D0) then
5447 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5448 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5455 c------------------------------------------------------------------------------
5456 subroutine splinthet(theti,delta,ss,ssder)
5457 implicit real*8 (a-h,o-z)
5458 include 'DIMENSIONS'
5459 include 'COMMON.VAR'
5460 include 'COMMON.GEO'
5463 if (theti.gt.pipol) then
5464 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5466 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5471 c------------------------------------------------------------------------------
5472 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5474 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5475 double precision ksi,ksi2,ksi3,a1,a2,a3
5476 a1=fprim0*delta/(f1-f0)
5482 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5483 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5486 c------------------------------------------------------------------------------
5487 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5489 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5490 double precision ksi,ksi2,ksi3,a1,a2,a3
5495 a2=3*(f1x-f0x)-2*fprim0x*delta
5496 a3=fprim0x*delta-2*(f1x-f0x)
5497 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5500 C-----------------------------------------------------------------------------
5502 C-----------------------------------------------------------------------------
5503 subroutine etor(etors,edihcnstr)
5504 implicit real*8 (a-h,o-z)
5505 include 'DIMENSIONS'
5506 include 'COMMON.VAR'
5507 include 'COMMON.GEO'
5508 include 'COMMON.LOCAL'
5509 include 'COMMON.TORSION'
5510 include 'COMMON.INTERACT'
5511 include 'COMMON.DERIV'
5512 include 'COMMON.CHAIN'
5513 include 'COMMON.NAMES'
5514 include 'COMMON.IOUNITS'
5515 include 'COMMON.FFIELD'
5516 include 'COMMON.TORCNSTR'
5517 include 'COMMON.CONTROL'
5519 C Set lprn=.true. for debugging
5523 do i=iphi_start,iphi_end
5525 itori=itortyp(itype(i-2))
5526 itori1=itortyp(itype(i-1))
5529 C Proline-Proline pair is a special case...
5530 if (itori.eq.3 .and. itori1.eq.3) then
5531 if (phii.gt.-dwapi3) then
5533 fac=1.0D0/(1.0D0-cosphi)
5534 etorsi=v1(1,3,3)*fac
5535 etorsi=etorsi+etorsi
5536 etors=etors+etorsi-v1(1,3,3)
5537 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5538 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5541 v1ij=v1(j+1,itori,itori1)
5542 v2ij=v2(j+1,itori,itori1)
5545 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5546 if (energy_dec) etors_ii=etors_ii+
5547 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5548 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5552 v1ij=v1(j,itori,itori1)
5553 v2ij=v2(j,itori,itori1)
5556 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5557 if (energy_dec) etors_ii=etors_ii+
5558 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5559 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5562 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5565 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5566 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5567 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5568 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5569 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5571 ! 6/20/98 - dihedral angle constraints
5574 itori=idih_constr(i)
5577 if (difi.gt.drange(i)) then
5579 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5580 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5581 else if (difi.lt.-drange(i)) then
5583 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5584 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5586 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5587 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5589 ! write (iout,*) 'edihcnstr',edihcnstr
5592 c------------------------------------------------------------------------------
5593 subroutine etor_d(etors_d)
5597 c----------------------------------------------------------------------------
5599 subroutine etor(etors,edihcnstr)
5600 implicit real*8 (a-h,o-z)
5601 include 'DIMENSIONS'
5602 include 'COMMON.VAR'
5603 include 'COMMON.GEO'
5604 include 'COMMON.LOCAL'
5605 include 'COMMON.TORSION'
5606 include 'COMMON.INTERACT'
5607 include 'COMMON.DERIV'
5608 include 'COMMON.CHAIN'
5609 include 'COMMON.NAMES'
5610 include 'COMMON.IOUNITS'
5611 include 'COMMON.FFIELD'
5612 include 'COMMON.TORCNSTR'
5613 include 'COMMON.CONTROL'
5615 C Set lprn=.true. for debugging
5619 do i=iphi_start,iphi_end
5621 itori=itortyp(itype(i-2))
5622 itori1=itortyp(itype(i-1))
5625 C Regular cosine and sine terms
5626 do j=1,nterm(itori,itori1)
5627 v1ij=v1(j,itori,itori1)
5628 v2ij=v2(j,itori,itori1)
5631 etors=etors+v1ij*cosphi+v2ij*sinphi
5632 if (energy_dec) etors_ii=etors_ii+
5633 & v1ij*cosphi+v2ij*sinphi
5634 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5638 C E = SUM ----------------------------------- - v1
5639 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5641 cosphi=dcos(0.5d0*phii)
5642 sinphi=dsin(0.5d0*phii)
5643 do j=1,nlor(itori,itori1)
5644 vl1ij=vlor1(j,itori,itori1)
5645 vl2ij=vlor2(j,itori,itori1)
5646 vl3ij=vlor3(j,itori,itori1)
5647 pom=vl2ij*cosphi+vl3ij*sinphi
5648 pom1=1.0d0/(pom*pom+1.0d0)
5649 etors=etors+vl1ij*pom1
5650 if (energy_dec) etors_ii=etors_ii+
5653 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5655 C Subtract the constant term
5656 etors=etors-v0(itori,itori1)
5657 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5658 & 'etor',i,etors_ii-v0(itori,itori1)
5660 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5661 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5662 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5663 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5664 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5666 ! 6/20/98 - dihedral angle constraints
5668 c do i=1,ndih_constr
5669 do i=idihconstr_start,idihconstr_end
5670 itori=idih_constr(i)
5672 difi=pinorm(phii-phi0(i))
5673 if (difi.gt.drange(i)) then
5675 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5676 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5677 else if (difi.lt.-drange(i)) then
5679 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5680 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5684 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5685 cd & rad2deg*phi0(i), rad2deg*drange(i),
5686 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5688 cd write (iout,*) 'edihcnstr',edihcnstr
5691 c----------------------------------------------------------------------------
5692 subroutine etor_d(etors_d)
5693 C 6/23/01 Compute double torsional energy
5694 implicit real*8 (a-h,o-z)
5695 include 'DIMENSIONS'
5696 include 'COMMON.VAR'
5697 include 'COMMON.GEO'
5698 include 'COMMON.LOCAL'
5699 include 'COMMON.TORSION'
5700 include 'COMMON.INTERACT'
5701 include 'COMMON.DERIV'
5702 include 'COMMON.CHAIN'
5703 include 'COMMON.NAMES'
5704 include 'COMMON.IOUNITS'
5705 include 'COMMON.FFIELD'
5706 include 'COMMON.TORCNSTR'
5708 C Set lprn=.true. for debugging
5712 do i=iphid_start,iphid_end
5713 itori=itortyp(itype(i-2))
5714 itori1=itortyp(itype(i-1))
5715 itori2=itortyp(itype(i))
5720 C Regular cosine and sine terms
5721 do j=1,ntermd_1(itori,itori1,itori2)
5722 v1cij=v1c(1,j,itori,itori1,itori2)
5723 v1sij=v1s(1,j,itori,itori1,itori2)
5724 v2cij=v1c(2,j,itori,itori1,itori2)
5725 v2sij=v1s(2,j,itori,itori1,itori2)
5726 cosphi1=dcos(j*phii)
5727 sinphi1=dsin(j*phii)
5728 cosphi2=dcos(j*phii1)
5729 sinphi2=dsin(j*phii1)
5730 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5731 & v2cij*cosphi2+v2sij*sinphi2
5732 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5733 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5735 do k=2,ntermd_2(itori,itori1,itori2)
5737 v1cdij = v2c(k,l,itori,itori1,itori2)
5738 v2cdij = v2c(l,k,itori,itori1,itori2)
5739 v1sdij = v2s(k,l,itori,itori1,itori2)
5740 v2sdij = v2s(l,k,itori,itori1,itori2)
5741 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5742 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5743 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5744 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5745 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5746 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5747 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5748 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5749 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5750 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5753 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5754 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5759 c------------------------------------------------------------------------------
5760 subroutine eback_sc_corr(esccor)
5761 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5762 c conformational states; temporarily implemented as differences
5763 c between UNRES torsional potentials (dependent on three types of
5764 c residues) and the torsional potentials dependent on all 20 types
5765 c of residues computed from AM1 energy surfaces of terminally-blocked
5766 c amino-acid residues.
5767 implicit real*8 (a-h,o-z)
5768 include 'DIMENSIONS'
5769 include 'COMMON.VAR'
5770 include 'COMMON.GEO'
5771 include 'COMMON.LOCAL'
5772 include 'COMMON.TORSION'
5773 include 'COMMON.SCCOR'
5774 include 'COMMON.INTERACT'
5775 include 'COMMON.DERIV'
5776 include 'COMMON.CHAIN'
5777 include 'COMMON.NAMES'
5778 include 'COMMON.IOUNITS'
5779 include 'COMMON.FFIELD'
5780 include 'COMMON.CONTROL'
5782 C Set lprn=.true. for debugging
5783 C Set lprn=.true. for debugging
5786 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5788 do i=itau_start,itau_end
5790 isccori=isccortyp(itype(i-2))
5791 isccori1=isccortyp(itype(i-1))
5792 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5794 do intertyp=1,3 !intertyp
5795 cc Added 09 May 2012 (Adasko)
5796 cc Intertyp means interaction type of backbone mainchain correlation:
5797 c 1 = SC...Ca...Ca...Ca
5798 c 2 = Ca...Ca...Ca...SC
5799 c 3 = SC...Ca...Ca...SCi
5801 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5802 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5803 & (itype(i-1).eq.ntyp1)))
5804 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5805 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5806 & .or.(itype(i).eq.ntyp1)))
5807 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5808 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5809 & (itype(i-3).eq.ntyp1)))) cycle
5810 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5811 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5813 do j=1,nterm_sccor(isccori,isccori1)
5814 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5815 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5816 cosphi=dcos(j*tauangle(intertyp,i))
5817 sinphi=dsin(j*tauangle(intertyp,i))
5818 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5819 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5821 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
5822 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5824 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5825 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5826 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5827 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5828 C gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5833 c----------------------------------------------------------------------------
5834 subroutine multibody(ecorr)
5835 C This subroutine calculates multi-body contributions to energy following
5836 C the idea of Skolnick et al. If side chains I and J make a contact and
5837 C at the same time side chains I+1 and J+1 make a contact, an extra
5838 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5839 implicit real*8 (a-h,o-z)
5840 include 'DIMENSIONS'
5841 include 'COMMON.IOUNITS'
5842 include 'COMMON.DERIV'
5843 include 'COMMON.INTERACT'
5844 include 'COMMON.CONTACTS'
5845 double precision gx(3),gx1(3)
5848 C Set lprn=.true. for debugging
5852 write (iout,'(a)') 'Contact function values:'
5854 write (iout,'(i2,20(1x,i2,f10.5))')
5855 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5870 num_conti=num_cont(i)
5871 num_conti1=num_cont(i1)
5876 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5877 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5878 cd & ' ishift=',ishift
5879 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5880 C The system gains extra energy.
5881 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5882 endif ! j1==j+-ishift
5891 c------------------------------------------------------------------------------
5892 double precision function esccorr(i,j,k,l,jj,kk)
5893 implicit real*8 (a-h,o-z)
5894 include 'DIMENSIONS'
5895 include 'COMMON.IOUNITS'
5896 include 'COMMON.DERIV'
5897 include 'COMMON.INTERACT'
5898 include 'COMMON.CONTACTS'
5899 double precision gx(3),gx1(3)
5904 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5905 C Calculate the multi-body contribution to energy.
5906 C Calculate multi-body contributions to the gradient.
5907 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5908 cd & k,l,(gacont(m,kk,k),m=1,3)
5910 gx(m) =ekl*gacont(m,jj,i)
5911 gx1(m)=eij*gacont(m,kk,k)
5912 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5913 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5914 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5915 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5919 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5924 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5930 c------------------------------------------------------------------------------
5931 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5932 C This subroutine calculates multi-body contributions to hydrogen-bonding
5933 implicit real*8 (a-h,o-z)
5934 include 'DIMENSIONS'
5935 include 'COMMON.IOUNITS'
5938 parameter (max_cont=maxconts)
5939 parameter (max_dim=26)
5940 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5941 double precision zapas(max_dim,maxconts,max_fg_procs),
5942 & zapas_recv(max_dim,maxconts,max_fg_procs)
5943 common /przechowalnia/ zapas
5944 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5945 & status_array(MPI_STATUS_SIZE,maxconts*2)
5947 include 'COMMON.SETUP'
5948 include 'COMMON.FFIELD'
5949 include 'COMMON.DERIV'
5950 include 'COMMON.INTERACT'
5951 include 'COMMON.CONTACTS'
5952 include 'COMMON.CONTROL'
5953 include 'COMMON.LOCAL'
5954 double precision gx(3),gx1(3),time00
5957 C Set lprn=.true. for debugging
5962 if (nfgtasks.le.1) goto 30
5964 write (iout,'(a)') 'Contact function values before RECEIVE:'
5966 write (iout,'(2i3,50(1x,i2,f5.2))')
5967 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5968 & j=1,num_cont_hb(i))
5972 do i=1,ntask_cont_from
5975 do i=1,ntask_cont_to
5978 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5980 C Make the list of contacts to send to send to other procesors
5981 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5983 do i=iturn3_start,iturn3_end
5984 c write (iout,*) "make contact list turn3",i," num_cont",
5986 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5988 do i=iturn4_start,iturn4_end
5989 c write (iout,*) "make contact list turn4",i," num_cont",
5991 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5995 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5997 do j=1,num_cont_hb(i)
6000 iproc=iint_sent_local(k,jjc,ii)
6001 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6002 if (iproc.gt.0) then
6003 ncont_sent(iproc)=ncont_sent(iproc)+1
6004 nn=ncont_sent(iproc)
6006 zapas(2,nn,iproc)=jjc
6007 zapas(3,nn,iproc)=facont_hb(j,i)
6008 zapas(4,nn,iproc)=ees0p(j,i)
6009 zapas(5,nn,iproc)=ees0m(j,i)
6010 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6011 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6012 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6013 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6014 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6015 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6016 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6017 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6018 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6019 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6020 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6021 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6022 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6023 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6024 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6025 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6026 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6027 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6028 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6029 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6030 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6037 & "Numbers of contacts to be sent to other processors",
6038 & (ncont_sent(i),i=1,ntask_cont_to)
6039 write (iout,*) "Contacts sent"
6040 do ii=1,ntask_cont_to
6042 iproc=itask_cont_to(ii)
6043 write (iout,*) nn," contacts to processor",iproc,
6044 & " of CONT_TO_COMM group"
6046 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6054 CorrelID1=nfgtasks+fg_rank+1
6056 C Receive the numbers of needed contacts from other processors
6057 do ii=1,ntask_cont_from
6058 iproc=itask_cont_from(ii)
6060 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6061 & FG_COMM,req(ireq),IERR)
6063 c write (iout,*) "IRECV ended"
6065 C Send the number of contacts needed by other processors
6066 do ii=1,ntask_cont_to
6067 iproc=itask_cont_to(ii)
6069 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6070 & FG_COMM,req(ireq),IERR)
6072 c write (iout,*) "ISEND ended"
6073 c write (iout,*) "number of requests (nn)",ireq
6076 & call MPI_Waitall(ireq,req,status_array,ierr)
6078 c & "Numbers of contacts to be received from other processors",
6079 c & (ncont_recv(i),i=1,ntask_cont_from)
6083 do ii=1,ntask_cont_from
6084 iproc=itask_cont_from(ii)
6086 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6087 c & " of CONT_TO_COMM group"
6091 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6092 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6093 c write (iout,*) "ireq,req",ireq,req(ireq)
6096 C Send the contacts to processors that need them
6097 do ii=1,ntask_cont_to
6098 iproc=itask_cont_to(ii)
6100 c write (iout,*) nn," contacts to processor",iproc,
6101 c & " of CONT_TO_COMM group"
6104 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6105 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6106 c write (iout,*) "ireq,req",ireq,req(ireq)
6108 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6112 c write (iout,*) "number of requests (contacts)",ireq
6113 c write (iout,*) "req",(req(i),i=1,4)
6116 & call MPI_Waitall(ireq,req,status_array,ierr)
6117 do iii=1,ntask_cont_from
6118 iproc=itask_cont_from(iii)
6121 write (iout,*) "Received",nn," contacts from processor",iproc,
6122 & " of CONT_FROM_COMM group"
6125 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6130 ii=zapas_recv(1,i,iii)
6131 c Flag the received contacts to prevent double-counting
6132 jj=-zapas_recv(2,i,iii)
6133 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6135 nnn=num_cont_hb(ii)+1
6138 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6139 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6140 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6141 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6142 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6143 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6144 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6145 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6146 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6147 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6148 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6149 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6150 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6151 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6152 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6153 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6154 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6155 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6156 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6157 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6158 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6159 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6160 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6161 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6166 write (iout,'(a)') 'Contact function values after receive:'
6168 write (iout,'(2i3,50(1x,i3,f5.2))')
6169 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6170 & j=1,num_cont_hb(i))
6177 write (iout,'(a)') 'Contact function values:'
6179 write (iout,'(2i3,50(1x,i3,f5.2))')
6180 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6181 & j=1,num_cont_hb(i))
6185 C Remove the loop below after debugging !!!
6192 C Calculate the local-electrostatic correlation terms
6193 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6195 num_conti=num_cont_hb(i)
6196 num_conti1=num_cont_hb(i+1)
6203 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6204 c & ' jj=',jj,' kk=',kk
6205 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6206 & .or. j.lt.0 .and. j1.gt.0) .and.
6207 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6208 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6209 C The system gains extra energy.
6210 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6211 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6212 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6214 else if (j1.eq.j) then
6215 C Contacts I-J and I-(J+1) occur simultaneously.
6216 C The system loses extra energy.
6217 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6222 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6223 c & ' jj=',jj,' kk=',kk
6225 C Contacts I-J and (I+1)-J occur simultaneously.
6226 C The system loses extra energy.
6227 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6234 c------------------------------------------------------------------------------
6235 subroutine add_hb_contact(ii,jj,itask)
6236 implicit real*8 (a-h,o-z)
6237 include "DIMENSIONS"
6238 include "COMMON.IOUNITS"
6241 parameter (max_cont=maxconts)
6242 parameter (max_dim=26)
6243 include "COMMON.CONTACTS"
6244 double precision zapas(max_dim,maxconts,max_fg_procs),
6245 & zapas_recv(max_dim,maxconts,max_fg_procs)
6246 common /przechowalnia/ zapas
6247 integer i,j,ii,jj,iproc,itask(4),nn
6248 c write (iout,*) "itask",itask
6251 if (iproc.gt.0) then
6252 do j=1,num_cont_hb(ii)
6254 c write (iout,*) "i",ii," j",jj," jjc",jjc
6256 ncont_sent(iproc)=ncont_sent(iproc)+1
6257 nn=ncont_sent(iproc)
6258 zapas(1,nn,iproc)=ii
6259 zapas(2,nn,iproc)=jjc
6260 zapas(3,nn,iproc)=facont_hb(j,ii)
6261 zapas(4,nn,iproc)=ees0p(j,ii)
6262 zapas(5,nn,iproc)=ees0m(j,ii)
6263 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6264 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6265 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6266 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6267 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6268 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6269 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6270 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6271 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6272 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6273 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6274 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6275 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6276 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6277 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6278 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6279 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6280 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6281 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6282 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6283 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6291 c------------------------------------------------------------------------------
6292 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6294 C This subroutine calculates multi-body contributions to hydrogen-bonding
6295 implicit real*8 (a-h,o-z)
6296 include 'DIMENSIONS'
6297 include 'COMMON.IOUNITS'
6300 parameter (max_cont=maxconts)
6301 parameter (max_dim=70)
6302 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6303 double precision zapas(max_dim,maxconts,max_fg_procs),
6304 & zapas_recv(max_dim,maxconts,max_fg_procs)
6305 common /przechowalnia/ zapas
6306 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6307 & status_array(MPI_STATUS_SIZE,maxconts*2)
6309 include 'COMMON.SETUP'
6310 include 'COMMON.FFIELD'
6311 include 'COMMON.DERIV'
6312 include 'COMMON.LOCAL'
6313 include 'COMMON.INTERACT'
6314 include 'COMMON.CONTACTS'
6315 include 'COMMON.CHAIN'
6316 include 'COMMON.CONTROL'
6317 double precision gx(3),gx1(3)
6318 integer num_cont_hb_old(maxres)
6320 double precision eello4,eello5,eelo6,eello_turn6
6321 external eello4,eello5,eello6,eello_turn6
6322 C Set lprn=.true. for debugging
6327 num_cont_hb_old(i)=num_cont_hb(i)
6331 if (nfgtasks.le.1) goto 30
6333 write (iout,'(a)') 'Contact function values before RECEIVE:'
6335 write (iout,'(2i3,50(1x,i2,f5.2))')
6336 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6337 & j=1,num_cont_hb(i))
6341 do i=1,ntask_cont_from
6344 do i=1,ntask_cont_to
6347 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6349 C Make the list of contacts to send to send to other procesors
6350 do i=iturn3_start,iturn3_end
6351 c write (iout,*) "make contact list turn3",i," num_cont",
6353 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6355 do i=iturn4_start,iturn4_end
6356 c write (iout,*) "make contact list turn4",i," num_cont",
6358 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6362 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6364 do j=1,num_cont_hb(i)
6367 iproc=iint_sent_local(k,jjc,ii)
6368 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6369 if (iproc.ne.0) then
6370 ncont_sent(iproc)=ncont_sent(iproc)+1
6371 nn=ncont_sent(iproc)
6373 zapas(2,nn,iproc)=jjc
6374 zapas(3,nn,iproc)=d_cont(j,i)
6378 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6383 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6391 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6402 & "Numbers of contacts to be sent to other processors",
6403 & (ncont_sent(i),i=1,ntask_cont_to)
6404 write (iout,*) "Contacts sent"
6405 do ii=1,ntask_cont_to
6407 iproc=itask_cont_to(ii)
6408 write (iout,*) nn," contacts to processor",iproc,
6409 & " of CONT_TO_COMM group"
6411 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6419 CorrelID1=nfgtasks+fg_rank+1
6421 C Receive the numbers of needed contacts from other processors
6422 do ii=1,ntask_cont_from
6423 iproc=itask_cont_from(ii)
6425 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6426 & FG_COMM,req(ireq),IERR)
6428 c write (iout,*) "IRECV ended"
6430 C Send the number of contacts needed by other processors
6431 do ii=1,ntask_cont_to
6432 iproc=itask_cont_to(ii)
6434 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6435 & FG_COMM,req(ireq),IERR)
6437 c write (iout,*) "ISEND ended"
6438 c write (iout,*) "number of requests (nn)",ireq
6441 & call MPI_Waitall(ireq,req,status_array,ierr)
6443 c & "Numbers of contacts to be received from other processors",
6444 c & (ncont_recv(i),i=1,ntask_cont_from)
6448 do ii=1,ntask_cont_from
6449 iproc=itask_cont_from(ii)
6451 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6452 c & " of CONT_TO_COMM group"
6456 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6457 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6458 c write (iout,*) "ireq,req",ireq,req(ireq)
6461 C Send the contacts to processors that need them
6462 do ii=1,ntask_cont_to
6463 iproc=itask_cont_to(ii)
6465 c write (iout,*) nn," contacts to processor",iproc,
6466 c & " of CONT_TO_COMM group"
6469 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6470 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6471 c write (iout,*) "ireq,req",ireq,req(ireq)
6473 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6477 c write (iout,*) "number of requests (contacts)",ireq
6478 c write (iout,*) "req",(req(i),i=1,4)
6481 & call MPI_Waitall(ireq,req,status_array,ierr)
6482 do iii=1,ntask_cont_from
6483 iproc=itask_cont_from(iii)
6486 write (iout,*) "Received",nn," contacts from processor",iproc,
6487 & " of CONT_FROM_COMM group"
6490 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6495 ii=zapas_recv(1,i,iii)
6496 c Flag the received contacts to prevent double-counting
6497 jj=-zapas_recv(2,i,iii)
6498 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6500 nnn=num_cont_hb(ii)+1
6503 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6507 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6512 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6520 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6529 write (iout,'(a)') 'Contact function values after receive:'
6531 write (iout,'(2i3,50(1x,i3,5f6.3))')
6532 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6533 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6540 write (iout,'(a)') 'Contact function values:'
6542 write (iout,'(2i3,50(1x,i2,5f6.3))')
6543 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6544 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6550 C Remove the loop below after debugging !!!
6557 C Calculate the dipole-dipole interaction energies
6558 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6559 do i=iatel_s,iatel_e+1
6560 num_conti=num_cont_hb(i)
6569 C Calculate the local-electrostatic correlation terms
6570 c write (iout,*) "gradcorr5 in eello5 before loop"
6572 c write (iout,'(i5,3f10.5)')
6573 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6575 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6576 c write (iout,*) "corr loop i",i
6578 num_conti=num_cont_hb(i)
6579 num_conti1=num_cont_hb(i+1)
6586 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6587 c & ' jj=',jj,' kk=',kk
6588 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6589 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6590 & .or. j.lt.0 .and. j1.gt.0) .and.
6591 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6592 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6593 C The system gains extra energy.
6595 sqd1=dsqrt(d_cont(jj,i))
6596 sqd2=dsqrt(d_cont(kk,i1))
6597 sred_geom = sqd1*sqd2
6598 IF (sred_geom.lt.cutoff_corr) THEN
6599 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6601 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6602 cd & ' jj=',jj,' kk=',kk
6603 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6604 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6606 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6607 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6610 cd write (iout,*) 'sred_geom=',sred_geom,
6611 cd & ' ekont=',ekont,' fprim=',fprimcont,
6612 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6613 cd write (iout,*) "g_contij",g_contij
6614 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6615 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6616 call calc_eello(i,jp,i+1,jp1,jj,kk)
6617 if (wcorr4.gt.0.0d0)
6618 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6619 if (energy_dec.and.wcorr4.gt.0.0d0)
6620 1 write (iout,'(a6,4i5,0pf7.3)')
6621 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6622 c write (iout,*) "gradcorr5 before eello5"
6624 c write (iout,'(i5,3f10.5)')
6625 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6627 if (wcorr5.gt.0.0d0)
6628 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6629 c write (iout,*) "gradcorr5 after eello5"
6631 c write (iout,'(i5,3f10.5)')
6632 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6634 if (energy_dec.and.wcorr5.gt.0.0d0)
6635 1 write (iout,'(a6,4i5,0pf7.3)')
6636 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6637 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6638 cd write(2,*)'ijkl',i,jp,i+1,jp1
6639 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6640 & .or. wturn6.eq.0.0d0))then
6641 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6642 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6643 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6644 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6645 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6646 cd & 'ecorr6=',ecorr6
6647 cd write (iout,'(4e15.5)') sred_geom,
6648 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6649 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6650 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6651 else if (wturn6.gt.0.0d0
6652 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6653 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6654 eturn6=eturn6+eello_turn6(i,jj,kk)
6655 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6656 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6657 cd write (2,*) 'multibody_eello:eturn6',eturn6
6666 num_cont_hb(i)=num_cont_hb_old(i)
6668 c write (iout,*) "gradcorr5 in eello5"
6670 c write (iout,'(i5,3f10.5)')
6671 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6675 c------------------------------------------------------------------------------
6676 subroutine add_hb_contact_eello(ii,jj,itask)
6677 implicit real*8 (a-h,o-z)
6678 include "DIMENSIONS"
6679 include "COMMON.IOUNITS"
6682 parameter (max_cont=maxconts)
6683 parameter (max_dim=70)
6684 include "COMMON.CONTACTS"
6685 double precision zapas(max_dim,maxconts,max_fg_procs),
6686 & zapas_recv(max_dim,maxconts,max_fg_procs)
6687 common /przechowalnia/ zapas
6688 integer i,j,ii,jj,iproc,itask(4),nn
6689 c write (iout,*) "itask",itask
6692 if (iproc.gt.0) then
6693 do j=1,num_cont_hb(ii)
6695 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6697 ncont_sent(iproc)=ncont_sent(iproc)+1
6698 nn=ncont_sent(iproc)
6699 zapas(1,nn,iproc)=ii
6700 zapas(2,nn,iproc)=jjc
6701 zapas(3,nn,iproc)=d_cont(j,ii)
6705 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6710 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6718 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6730 c------------------------------------------------------------------------------
6731 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6732 implicit real*8 (a-h,o-z)
6733 include 'DIMENSIONS'
6734 include 'COMMON.IOUNITS'
6735 include 'COMMON.DERIV'
6736 include 'COMMON.INTERACT'
6737 include 'COMMON.CONTACTS'
6738 double precision gx(3),gx1(3)
6748 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6749 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6750 C Following 4 lines for diagnostics.
6755 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6756 c & 'Contacts ',i,j,
6757 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6758 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6760 C Calculate the multi-body contribution to energy.
6761 c ecorr=ecorr+ekont*ees
6762 C Calculate multi-body contributions to the gradient.
6763 coeffpees0pij=coeffp*ees0pij
6764 coeffmees0mij=coeffm*ees0mij
6765 coeffpees0pkl=coeffp*ees0pkl
6766 coeffmees0mkl=coeffm*ees0mkl
6768 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6769 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6770 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6771 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6772 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6773 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6774 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6775 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6776 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6777 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6778 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6779 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6780 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6781 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6782 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6783 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6784 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6785 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6786 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6787 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6788 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6789 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6790 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6791 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6792 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6797 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6798 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6799 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6800 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6805 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6806 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6807 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6808 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6811 c write (iout,*) "ehbcorr",ekont*ees
6816 C---------------------------------------------------------------------------
6817 subroutine dipole(i,j,jj)
6818 implicit real*8 (a-h,o-z)
6819 include 'DIMENSIONS'
6820 include 'COMMON.IOUNITS'
6821 include 'COMMON.CHAIN'
6822 include 'COMMON.FFIELD'
6823 include 'COMMON.DERIV'
6824 include 'COMMON.INTERACT'
6825 include 'COMMON.CONTACTS'
6826 include 'COMMON.TORSION'
6827 include 'COMMON.VAR'
6828 include 'COMMON.GEO'
6829 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6831 iti1 = itortyp(itype(i+1))
6832 if (j.lt.nres-1) then
6833 itj1 = itortyp(itype(j+1))
6838 dipi(iii,1)=Ub2(iii,i)
6839 dipderi(iii)=Ub2der(iii,i)
6840 dipi(iii,2)=b1(iii,iti1)
6841 dipj(iii,1)=Ub2(iii,j)
6842 dipderj(iii)=Ub2der(iii,j)
6843 dipj(iii,2)=b1(iii,itj1)
6847 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6850 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6857 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6861 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6866 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6867 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6869 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6871 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6873 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6878 C---------------------------------------------------------------------------
6879 subroutine calc_eello(i,j,k,l,jj,kk)
6881 C This subroutine computes matrices and vectors needed to calculate
6882 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6884 implicit real*8 (a-h,o-z)
6885 include 'DIMENSIONS'
6886 include 'COMMON.IOUNITS'
6887 include 'COMMON.CHAIN'
6888 include 'COMMON.DERIV'
6889 include 'COMMON.INTERACT'
6890 include 'COMMON.CONTACTS'
6891 include 'COMMON.TORSION'
6892 include 'COMMON.VAR'
6893 include 'COMMON.GEO'
6894 include 'COMMON.FFIELD'
6895 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6896 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6899 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6900 cd & ' jj=',jj,' kk=',kk
6901 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6902 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6903 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6906 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6907 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6910 call transpose2(aa1(1,1),aa1t(1,1))
6911 call transpose2(aa2(1,1),aa2t(1,1))
6914 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6915 & aa1tder(1,1,lll,kkk))
6916 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6917 & aa2tder(1,1,lll,kkk))
6921 C parallel orientation of the two CA-CA-CA frames.
6923 iti=itortyp(itype(i))
6927 itk1=itortyp(itype(k+1))
6928 itj=itortyp(itype(j))
6929 if (l.lt.nres-1) then
6930 itl1=itortyp(itype(l+1))
6934 C A1 kernel(j+1) A2T
6936 cd write (iout,'(3f10.5,5x,3f10.5)')
6937 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6939 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6940 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6941 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6942 C Following matrices are needed only for 6-th order cumulants
6943 IF (wcorr6.gt.0.0d0) THEN
6944 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6945 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6946 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6947 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6948 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6949 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6950 & ADtEAderx(1,1,1,1,1,1))
6952 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6953 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6954 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6955 & ADtEA1derx(1,1,1,1,1,1))
6957 C End 6-th order cumulants
6960 cd write (2,*) 'In calc_eello6'
6962 cd write (2,*) 'iii=',iii
6964 cd write (2,*) 'kkk=',kkk
6966 cd write (2,'(3(2f10.5),5x)')
6967 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6972 call transpose2(EUgder(1,1,k),auxmat(1,1))
6973 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6974 call transpose2(EUg(1,1,k),auxmat(1,1))
6975 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6976 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6980 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6981 & EAEAderx(1,1,lll,kkk,iii,1))
6985 C A1T kernel(i+1) A2
6986 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6987 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6988 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6989 C Following matrices are needed only for 6-th order cumulants
6990 IF (wcorr6.gt.0.0d0) THEN
6991 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6992 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6993 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6994 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6995 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6996 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6997 & ADtEAderx(1,1,1,1,1,2))
6998 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6999 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7000 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7001 & ADtEA1derx(1,1,1,1,1,2))
7003 C End 6-th order cumulants
7004 call transpose2(EUgder(1,1,l),auxmat(1,1))
7005 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7006 call transpose2(EUg(1,1,l),auxmat(1,1))
7007 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7008 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7012 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7013 & EAEAderx(1,1,lll,kkk,iii,2))
7018 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7019 C They are needed only when the fifth- or the sixth-order cumulants are
7021 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7022 call transpose2(AEA(1,1,1),auxmat(1,1))
7023 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7024 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7025 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7026 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7027 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7028 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7029 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7030 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7031 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7032 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7033 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7034 call transpose2(AEA(1,1,2),auxmat(1,1))
7035 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7036 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7037 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7038 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7039 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7040 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7041 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7042 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7043 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7044 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7045 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7046 C Calculate the Cartesian derivatives of the vectors.
7050 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7051 call matvec2(auxmat(1,1),b1(1,iti),
7052 & AEAb1derx(1,lll,kkk,iii,1,1))
7053 call matvec2(auxmat(1,1),Ub2(1,i),
7054 & AEAb2derx(1,lll,kkk,iii,1,1))
7055 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7056 & AEAb1derx(1,lll,kkk,iii,2,1))
7057 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7058 & AEAb2derx(1,lll,kkk,iii,2,1))
7059 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7060 call matvec2(auxmat(1,1),b1(1,itj),
7061 & AEAb1derx(1,lll,kkk,iii,1,2))
7062 call matvec2(auxmat(1,1),Ub2(1,j),
7063 & AEAb2derx(1,lll,kkk,iii,1,2))
7064 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7065 & AEAb1derx(1,lll,kkk,iii,2,2))
7066 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7067 & AEAb2derx(1,lll,kkk,iii,2,2))
7074 C Antiparallel orientation of the two CA-CA-CA frames.
7076 iti=itortyp(itype(i))
7080 itk1=itortyp(itype(k+1))
7081 itl=itortyp(itype(l))
7082 itj=itortyp(itype(j))
7083 if (j.lt.nres-1) then
7084 itj1=itortyp(itype(j+1))
7088 C A2 kernel(j-1)T A1T
7089 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7090 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7091 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7092 C Following matrices are needed only for 6-th order cumulants
7093 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7094 & j.eq.i+4 .and. l.eq.i+3)) THEN
7095 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7096 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7097 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7098 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7099 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7100 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7101 & ADtEAderx(1,1,1,1,1,1))
7102 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7103 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7104 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7105 & ADtEA1derx(1,1,1,1,1,1))
7107 C End 6-th order cumulants
7108 call transpose2(EUgder(1,1,k),auxmat(1,1))
7109 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7110 call transpose2(EUg(1,1,k),auxmat(1,1))
7111 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7112 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7116 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7117 & EAEAderx(1,1,lll,kkk,iii,1))
7121 C A2T kernel(i+1)T A1
7122 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7123 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7124 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7125 C Following matrices are needed only for 6-th order cumulants
7126 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7127 & j.eq.i+4 .and. l.eq.i+3)) THEN
7128 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7129 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7130 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7131 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7132 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7133 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7134 & ADtEAderx(1,1,1,1,1,2))
7135 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7136 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7137 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7138 & ADtEA1derx(1,1,1,1,1,2))
7140 C End 6-th order cumulants
7141 call transpose2(EUgder(1,1,j),auxmat(1,1))
7142 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7143 call transpose2(EUg(1,1,j),auxmat(1,1))
7144 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7145 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7149 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7150 & EAEAderx(1,1,lll,kkk,iii,2))
7155 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7156 C They are needed only when the fifth- or the sixth-order cumulants are
7158 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7159 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7160 call transpose2(AEA(1,1,1),auxmat(1,1))
7161 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7162 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7163 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7164 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7165 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7166 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7167 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7168 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7169 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7170 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7171 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7172 call transpose2(AEA(1,1,2),auxmat(1,1))
7173 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7174 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7175 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7176 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7177 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7178 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7179 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7180 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7181 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7182 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7183 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7184 C Calculate the Cartesian derivatives of the vectors.
7188 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7189 call matvec2(auxmat(1,1),b1(1,iti),
7190 & AEAb1derx(1,lll,kkk,iii,1,1))
7191 call matvec2(auxmat(1,1),Ub2(1,i),
7192 & AEAb2derx(1,lll,kkk,iii,1,1))
7193 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7194 & AEAb1derx(1,lll,kkk,iii,2,1))
7195 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7196 & AEAb2derx(1,lll,kkk,iii,2,1))
7197 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7198 call matvec2(auxmat(1,1),b1(1,itl),
7199 & AEAb1derx(1,lll,kkk,iii,1,2))
7200 call matvec2(auxmat(1,1),Ub2(1,l),
7201 & AEAb2derx(1,lll,kkk,iii,1,2))
7202 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7203 & AEAb1derx(1,lll,kkk,iii,2,2))
7204 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7205 & AEAb2derx(1,lll,kkk,iii,2,2))
7214 C---------------------------------------------------------------------------
7215 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7216 & KK,KKderg,AKA,AKAderg,AKAderx)
7220 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7221 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7222 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7227 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7229 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7232 cd if (lprn) write (2,*) 'In kernel'
7234 cd if (lprn) write (2,*) 'kkk=',kkk
7236 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7237 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7239 cd write (2,*) 'lll=',lll
7240 cd write (2,*) 'iii=1'
7242 cd write (2,'(3(2f10.5),5x)')
7243 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7246 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7247 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7249 cd write (2,*) 'lll=',lll
7250 cd write (2,*) 'iii=2'
7252 cd write (2,'(3(2f10.5),5x)')
7253 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7260 C---------------------------------------------------------------------------
7261 double precision function eello4(i,j,k,l,jj,kk)
7262 implicit real*8 (a-h,o-z)
7263 include 'DIMENSIONS'
7264 include 'COMMON.IOUNITS'
7265 include 'COMMON.CHAIN'
7266 include 'COMMON.DERIV'
7267 include 'COMMON.INTERACT'
7268 include 'COMMON.CONTACTS'
7269 include 'COMMON.TORSION'
7270 include 'COMMON.VAR'
7271 include 'COMMON.GEO'
7272 double precision pizda(2,2),ggg1(3),ggg2(3)
7273 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7277 cd print *,'eello4:',i,j,k,l,jj,kk
7278 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7279 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7280 cold eij=facont_hb(jj,i)
7281 cold ekl=facont_hb(kk,k)
7283 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7284 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7285 gcorr_loc(k-1)=gcorr_loc(k-1)
7286 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7288 gcorr_loc(l-1)=gcorr_loc(l-1)
7289 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7291 gcorr_loc(j-1)=gcorr_loc(j-1)
7292 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7297 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7298 & -EAEAderx(2,2,lll,kkk,iii,1)
7299 cd derx(lll,kkk,iii)=0.0d0
7303 cd gcorr_loc(l-1)=0.0d0
7304 cd gcorr_loc(j-1)=0.0d0
7305 cd gcorr_loc(k-1)=0.0d0
7307 cd write (iout,*)'Contacts have occurred for peptide groups',
7308 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7309 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7310 if (j.lt.nres-1) then
7317 if (l.lt.nres-1) then
7325 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7326 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7327 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7328 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7329 cgrad ghalf=0.5d0*ggg1(ll)
7330 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7331 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7332 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7333 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7334 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7335 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7336 cgrad ghalf=0.5d0*ggg2(ll)
7337 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7338 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7339 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7340 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7341 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7342 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7346 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7351 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7356 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7361 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7365 cd write (2,*) iii,gcorr_loc(iii)
7368 cd write (2,*) 'ekont',ekont
7369 cd write (iout,*) 'eello4',ekont*eel4
7372 C---------------------------------------------------------------------------
7373 double precision function eello5(i,j,k,l,jj,kk)
7374 implicit real*8 (a-h,o-z)
7375 include 'DIMENSIONS'
7376 include 'COMMON.IOUNITS'
7377 include 'COMMON.CHAIN'
7378 include 'COMMON.DERIV'
7379 include 'COMMON.INTERACT'
7380 include 'COMMON.CONTACTS'
7381 include 'COMMON.TORSION'
7382 include 'COMMON.VAR'
7383 include 'COMMON.GEO'
7384 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7385 double precision ggg1(3),ggg2(3)
7386 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7391 C /l\ / \ \ / \ / \ / C
7392 C / \ / \ \ / \ / \ / C
7393 C j| o |l1 | o | o| o | | o |o C
7394 C \ |/k\| |/ \| / |/ \| |/ \| C
7395 C \i/ \ / \ / / \ / \ C
7397 C (I) (II) (III) (IV) C
7399 C eello5_1 eello5_2 eello5_3 eello5_4 C
7401 C Antiparallel chains C
7404 C /j\ / \ \ / \ / \ / C
7405 C / \ / \ \ / \ / \ / C
7406 C j1| o |l | o | o| o | | o |o C
7407 C \ |/k\| |/ \| / |/ \| |/ \| C
7408 C \i/ \ / \ / / \ / \ C
7410 C (I) (II) (III) (IV) C
7412 C eello5_1 eello5_2 eello5_3 eello5_4 C
7414 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7416 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7417 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7422 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7424 itk=itortyp(itype(k))
7425 itl=itortyp(itype(l))
7426 itj=itortyp(itype(j))
7431 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7432 cd & eel5_3_num,eel5_4_num)
7436 derx(lll,kkk,iii)=0.0d0
7440 cd eij=facont_hb(jj,i)
7441 cd ekl=facont_hb(kk,k)
7443 cd write (iout,*)'Contacts have occurred for peptide groups',
7444 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7446 C Contribution from the graph I.
7447 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7448 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7449 call transpose2(EUg(1,1,k),auxmat(1,1))
7450 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7451 vv(1)=pizda(1,1)-pizda(2,2)
7452 vv(2)=pizda(1,2)+pizda(2,1)
7453 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7454 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7455 C Explicit gradient in virtual-dihedral angles.
7456 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7457 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7458 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7459 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7460 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7461 vv(1)=pizda(1,1)-pizda(2,2)
7462 vv(2)=pizda(1,2)+pizda(2,1)
7463 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7464 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7465 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7466 call matmat2(AEAderg(1,1,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)
7470 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7471 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7472 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7474 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7475 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7476 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7478 C Cartesian gradient
7482 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7484 vv(1)=pizda(1,1)-pizda(2,2)
7485 vv(2)=pizda(1,2)+pizda(2,1)
7486 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7487 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7488 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7494 C Contribution from graph II
7495 call transpose2(EE(1,1,itk),auxmat(1,1))
7496 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7497 vv(1)=pizda(1,1)+pizda(2,2)
7498 vv(2)=pizda(2,1)-pizda(1,2)
7499 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7500 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7501 C Explicit gradient in virtual-dihedral angles.
7502 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7503 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7504 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7505 vv(1)=pizda(1,1)+pizda(2,2)
7506 vv(2)=pizda(2,1)-pizda(1,2)
7508 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7509 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7510 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7512 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7513 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7514 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7516 C Cartesian gradient
7520 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7522 vv(1)=pizda(1,1)+pizda(2,2)
7523 vv(2)=pizda(2,1)-pizda(1,2)
7524 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7525 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7526 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7534 C Parallel orientation
7535 C Contribution from graph III
7536 call transpose2(EUg(1,1,l),auxmat(1,1))
7537 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7538 vv(1)=pizda(1,1)-pizda(2,2)
7539 vv(2)=pizda(1,2)+pizda(2,1)
7540 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7541 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7542 C Explicit gradient in virtual-dihedral angles.
7543 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7544 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7545 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7546 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7547 vv(1)=pizda(1,1)-pizda(2,2)
7548 vv(2)=pizda(1,2)+pizda(2,1)
7549 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7550 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7551 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7552 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7553 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7554 vv(1)=pizda(1,1)-pizda(2,2)
7555 vv(2)=pizda(1,2)+pizda(2,1)
7556 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7557 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7558 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7559 C Cartesian gradient
7563 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7565 vv(1)=pizda(1,1)-pizda(2,2)
7566 vv(2)=pizda(1,2)+pizda(2,1)
7567 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7568 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7569 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7574 C Contribution from graph IV
7576 call transpose2(EE(1,1,itl),auxmat(1,1))
7577 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7578 vv(1)=pizda(1,1)+pizda(2,2)
7579 vv(2)=pizda(2,1)-pizda(1,2)
7580 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7581 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7582 C Explicit gradient in virtual-dihedral angles.
7583 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7584 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7585 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7586 vv(1)=pizda(1,1)+pizda(2,2)
7587 vv(2)=pizda(2,1)-pizda(1,2)
7588 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7589 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7590 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7591 C Cartesian gradient
7595 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7597 vv(1)=pizda(1,1)+pizda(2,2)
7598 vv(2)=pizda(2,1)-pizda(1,2)
7599 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7600 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7601 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7606 C Antiparallel orientation
7607 C Contribution from graph III
7609 call transpose2(EUg(1,1,j),auxmat(1,1))
7610 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7611 vv(1)=pizda(1,1)-pizda(2,2)
7612 vv(2)=pizda(1,2)+pizda(2,1)
7613 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7614 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7615 C Explicit gradient in virtual-dihedral angles.
7616 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7617 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7618 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7619 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7620 vv(1)=pizda(1,1)-pizda(2,2)
7621 vv(2)=pizda(1,2)+pizda(2,1)
7622 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7623 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7624 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7625 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7626 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7627 vv(1)=pizda(1,1)-pizda(2,2)
7628 vv(2)=pizda(1,2)+pizda(2,1)
7629 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7630 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7631 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7632 C Cartesian gradient
7636 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7638 vv(1)=pizda(1,1)-pizda(2,2)
7639 vv(2)=pizda(1,2)+pizda(2,1)
7640 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7641 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7642 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7647 C Contribution from graph IV
7649 call transpose2(EE(1,1,itj),auxmat(1,1))
7650 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7651 vv(1)=pizda(1,1)+pizda(2,2)
7652 vv(2)=pizda(2,1)-pizda(1,2)
7653 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7654 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7655 C Explicit gradient in virtual-dihedral angles.
7656 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7657 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7658 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7659 vv(1)=pizda(1,1)+pizda(2,2)
7660 vv(2)=pizda(2,1)-pizda(1,2)
7661 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7662 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7663 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7664 C Cartesian gradient
7668 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7670 vv(1)=pizda(1,1)+pizda(2,2)
7671 vv(2)=pizda(2,1)-pizda(1,2)
7672 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7673 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7674 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7680 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7681 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7682 cd write (2,*) 'ijkl',i,j,k,l
7683 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7684 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7686 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7687 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7688 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7689 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7690 if (j.lt.nres-1) then
7697 if (l.lt.nres-1) then
7707 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7708 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7709 C summed up outside the subrouine as for the other subroutines
7710 C handling long-range interactions. The old code is commented out
7711 C with "cgrad" to keep track of changes.
7713 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7714 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7715 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7716 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7717 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7718 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7719 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7720 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7721 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7722 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7724 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7725 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7726 cgrad ghalf=0.5d0*ggg1(ll)
7728 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7729 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7730 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7731 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7732 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7733 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7734 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7735 cgrad ghalf=0.5d0*ggg2(ll)
7737 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7738 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7739 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7740 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7741 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7742 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7747 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7748 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7753 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7754 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7760 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7765 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7769 cd write (2,*) iii,g_corr5_loc(iii)
7772 cd write (2,*) 'ekont',ekont
7773 cd write (iout,*) 'eello5',ekont*eel5
7776 c--------------------------------------------------------------------------
7777 double precision function eello6(i,j,k,l,jj,kk)
7778 implicit real*8 (a-h,o-z)
7779 include 'DIMENSIONS'
7780 include 'COMMON.IOUNITS'
7781 include 'COMMON.CHAIN'
7782 include 'COMMON.DERIV'
7783 include 'COMMON.INTERACT'
7784 include 'COMMON.CONTACTS'
7785 include 'COMMON.TORSION'
7786 include 'COMMON.VAR'
7787 include 'COMMON.GEO'
7788 include 'COMMON.FFIELD'
7789 double precision ggg1(3),ggg2(3)
7790 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7795 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7803 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7804 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7808 derx(lll,kkk,iii)=0.0d0
7812 cd eij=facont_hb(jj,i)
7813 cd ekl=facont_hb(kk,k)
7819 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7820 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7821 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7822 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7823 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7824 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7826 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7827 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7828 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7829 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7830 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7831 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7835 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7837 C If turn contributions are considered, they will be handled separately.
7838 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7839 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7840 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7841 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7842 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7843 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7844 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7846 if (j.lt.nres-1) then
7853 if (l.lt.nres-1) then
7861 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7862 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7863 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7864 cgrad ghalf=0.5d0*ggg1(ll)
7866 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7867 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7868 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7869 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7870 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7871 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7872 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7873 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7874 cgrad ghalf=0.5d0*ggg2(ll)
7875 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7877 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7878 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7879 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7880 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7881 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7882 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7887 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7888 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7893 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7894 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7900 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7905 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7909 cd write (2,*) iii,g_corr6_loc(iii)
7912 cd write (2,*) 'ekont',ekont
7913 cd write (iout,*) 'eello6',ekont*eel6
7916 c--------------------------------------------------------------------------
7917 double precision function eello6_graph1(i,j,k,l,imat,swap)
7918 implicit real*8 (a-h,o-z)
7919 include 'DIMENSIONS'
7920 include 'COMMON.IOUNITS'
7921 include 'COMMON.CHAIN'
7922 include 'COMMON.DERIV'
7923 include 'COMMON.INTERACT'
7924 include 'COMMON.CONTACTS'
7925 include 'COMMON.TORSION'
7926 include 'COMMON.VAR'
7927 include 'COMMON.GEO'
7928 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7932 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7934 C Parallel Antiparallel C
7940 C \ j|/k\| / \ |/k\|l / C
7945 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7946 itk=itortyp(itype(k))
7947 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7948 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7949 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7950 call transpose2(EUgC(1,1,k),auxmat(1,1))
7951 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7952 vv1(1)=pizda1(1,1)-pizda1(2,2)
7953 vv1(2)=pizda1(1,2)+pizda1(2,1)
7954 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7955 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7956 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7957 s5=scalar2(vv(1),Dtobr2(1,i))
7958 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7959 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7960 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7961 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7962 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7963 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7964 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7965 & +scalar2(vv(1),Dtobr2der(1,i)))
7966 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7967 vv1(1)=pizda1(1,1)-pizda1(2,2)
7968 vv1(2)=pizda1(1,2)+pizda1(2,1)
7969 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7970 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7972 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7973 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7974 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7975 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7976 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7978 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7979 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7980 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7981 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7982 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7984 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7985 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7986 vv1(1)=pizda1(1,1)-pizda1(2,2)
7987 vv1(2)=pizda1(1,2)+pizda1(2,1)
7988 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7989 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7990 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7991 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8000 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8001 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8002 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8003 call transpose2(EUgC(1,1,k),auxmat(1,1))
8004 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8006 vv1(1)=pizda1(1,1)-pizda1(2,2)
8007 vv1(2)=pizda1(1,2)+pizda1(2,1)
8008 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8009 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8010 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8011 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8012 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8013 s5=scalar2(vv(1),Dtobr2(1,i))
8014 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8020 c----------------------------------------------------------------------------
8021 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8022 implicit real*8 (a-h,o-z)
8023 include 'DIMENSIONS'
8024 include 'COMMON.IOUNITS'
8025 include 'COMMON.CHAIN'
8026 include 'COMMON.DERIV'
8027 include 'COMMON.INTERACT'
8028 include 'COMMON.CONTACTS'
8029 include 'COMMON.TORSION'
8030 include 'COMMON.VAR'
8031 include 'COMMON.GEO'
8033 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8034 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8037 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8039 C Parallel Antiparallel C
8045 C \ j|/k\| \ |/k\|l C
8050 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8051 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8052 C AL 7/4/01 s1 would occur in the sixth-order moment,
8053 C but not in a cluster cumulant
8055 s1=dip(1,jj,i)*dip(1,kk,k)
8057 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8058 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8059 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8060 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8061 call transpose2(EUg(1,1,k),auxmat(1,1))
8062 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8063 vv(1)=pizda(1,1)-pizda(2,2)
8064 vv(2)=pizda(1,2)+pizda(2,1)
8065 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8066 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8068 eello6_graph2=-(s1+s2+s3+s4)
8070 eello6_graph2=-(s2+s3+s4)
8073 C Derivatives in gamma(i-1)
8076 s1=dipderg(1,jj,i)*dip(1,kk,k)
8078 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8079 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8080 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8081 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8083 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8085 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8087 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8089 C Derivatives in gamma(k-1)
8091 s1=dip(1,jj,i)*dipderg(1,kk,k)
8093 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8094 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8095 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8096 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8097 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8098 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8099 vv(1)=pizda(1,1)-pizda(2,2)
8100 vv(2)=pizda(1,2)+pizda(2,1)
8101 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8103 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8105 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8107 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8108 C Derivatives in gamma(j-1) or gamma(l-1)
8111 s1=dipderg(3,jj,i)*dip(1,kk,k)
8113 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8114 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8115 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8116 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8117 vv(1)=pizda(1,1)-pizda(2,2)
8118 vv(2)=pizda(1,2)+pizda(2,1)
8119 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8122 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8124 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8127 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8128 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8130 C Derivatives in gamma(l-1) or gamma(j-1)
8133 s1=dip(1,jj,i)*dipderg(3,kk,k)
8135 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8136 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8137 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8138 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8139 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8140 vv(1)=pizda(1,1)-pizda(2,2)
8141 vv(2)=pizda(1,2)+pizda(2,1)
8142 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8145 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8147 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8150 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8151 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8153 C Cartesian derivatives.
8155 write (2,*) 'In eello6_graph2'
8157 write (2,*) 'iii=',iii
8159 write (2,*) 'kkk=',kkk
8161 write (2,'(3(2f10.5),5x)')
8162 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8172 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8174 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8177 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8179 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8180 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8182 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8183 call transpose2(EUg(1,1,k),auxmat(1,1))
8184 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8186 vv(1)=pizda(1,1)-pizda(2,2)
8187 vv(2)=pizda(1,2)+pizda(2,1)
8188 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8189 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8191 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8193 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8196 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8198 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8205 c----------------------------------------------------------------------------
8206 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8207 implicit real*8 (a-h,o-z)
8208 include 'DIMENSIONS'
8209 include 'COMMON.IOUNITS'
8210 include 'COMMON.CHAIN'
8211 include 'COMMON.DERIV'
8212 include 'COMMON.INTERACT'
8213 include 'COMMON.CONTACTS'
8214 include 'COMMON.TORSION'
8215 include 'COMMON.VAR'
8216 include 'COMMON.GEO'
8217 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8219 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8221 C Parallel Antiparallel C
8227 C j|/k\| / |/k\|l / C
8232 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8234 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8235 C energy moment and not to the cluster cumulant.
8236 iti=itortyp(itype(i))
8237 if (j.lt.nres-1) then
8238 itj1=itortyp(itype(j+1))
8242 itk=itortyp(itype(k))
8243 itk1=itortyp(itype(k+1))
8244 if (l.lt.nres-1) then
8245 itl1=itortyp(itype(l+1))
8250 s1=dip(4,jj,i)*dip(4,kk,k)
8252 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8253 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8254 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8255 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8256 call transpose2(EE(1,1,itk),auxmat(1,1))
8257 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8258 vv(1)=pizda(1,1)+pizda(2,2)
8259 vv(2)=pizda(2,1)-pizda(1,2)
8260 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8261 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8262 cd & "sum",-(s2+s3+s4)
8264 eello6_graph3=-(s1+s2+s3+s4)
8266 eello6_graph3=-(s2+s3+s4)
8269 C Derivatives in gamma(k-1)
8270 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8271 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8272 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8273 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8274 C Derivatives in gamma(l-1)
8275 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8276 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8277 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8278 vv(1)=pizda(1,1)+pizda(2,2)
8279 vv(2)=pizda(2,1)-pizda(1,2)
8280 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8281 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8282 C Cartesian derivatives.
8288 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8290 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8293 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8295 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8296 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8298 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8299 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8301 vv(1)=pizda(1,1)+pizda(2,2)
8302 vv(2)=pizda(2,1)-pizda(1,2)
8303 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8305 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8307 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8310 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8312 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8314 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8320 c----------------------------------------------------------------------------
8321 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8322 implicit real*8 (a-h,o-z)
8323 include 'DIMENSIONS'
8324 include 'COMMON.IOUNITS'
8325 include 'COMMON.CHAIN'
8326 include 'COMMON.DERIV'
8327 include 'COMMON.INTERACT'
8328 include 'COMMON.CONTACTS'
8329 include 'COMMON.TORSION'
8330 include 'COMMON.VAR'
8331 include 'COMMON.GEO'
8332 include 'COMMON.FFIELD'
8333 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8334 & auxvec1(2),auxmat1(2,2)
8336 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8338 C Parallel Antiparallel C
8344 C \ j|/k\| \ |/k\|l C
8349 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8351 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8352 C energy moment and not to the cluster cumulant.
8353 cd write (2,*) 'eello_graph4: wturn6',wturn6
8354 iti=itortyp(itype(i))
8355 itj=itortyp(itype(j))
8356 if (j.lt.nres-1) then
8357 itj1=itortyp(itype(j+1))
8361 itk=itortyp(itype(k))
8362 if (k.lt.nres-1) then
8363 itk1=itortyp(itype(k+1))
8367 itl=itortyp(itype(l))
8368 if (l.lt.nres-1) then
8369 itl1=itortyp(itype(l+1))
8373 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8374 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8375 cd & ' itl',itl,' itl1',itl1
8378 s1=dip(3,jj,i)*dip(3,kk,k)
8380 s1=dip(2,jj,j)*dip(2,kk,l)
8383 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8384 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8386 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8387 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8389 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8390 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8392 call transpose2(EUg(1,1,k),auxmat(1,1))
8393 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8394 vv(1)=pizda(1,1)-pizda(2,2)
8395 vv(2)=pizda(2,1)+pizda(1,2)
8396 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8397 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8399 eello6_graph4=-(s1+s2+s3+s4)
8401 eello6_graph4=-(s2+s3+s4)
8403 C Derivatives in gamma(i-1)
8407 s1=dipderg(2,jj,i)*dip(3,kk,k)
8409 s1=dipderg(4,jj,j)*dip(2,kk,l)
8412 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8414 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8415 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8417 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8418 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8420 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8421 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8422 cd write (2,*) 'turn6 derivatives'
8424 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8426 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8430 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8432 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8436 C Derivatives in gamma(k-1)
8439 s1=dip(3,jj,i)*dipderg(2,kk,k)
8441 s1=dip(2,jj,j)*dipderg(4,kk,l)
8444 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8445 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8447 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8448 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8450 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8451 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8453 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8454 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8455 vv(1)=pizda(1,1)-pizda(2,2)
8456 vv(2)=pizda(2,1)+pizda(1,2)
8457 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8458 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8460 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8462 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8466 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8468 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8471 C Derivatives in gamma(j-1) or gamma(l-1)
8472 if (l.eq.j+1 .and. l.gt.1) then
8473 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8474 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8475 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8476 vv(1)=pizda(1,1)-pizda(2,2)
8477 vv(2)=pizda(2,1)+pizda(1,2)
8478 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8479 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8480 else if (j.gt.1) then
8481 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8482 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8483 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8484 vv(1)=pizda(1,1)-pizda(2,2)
8485 vv(2)=pizda(2,1)+pizda(1,2)
8486 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8487 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8488 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8490 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8493 C Cartesian derivatives.
8500 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8502 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8506 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8508 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8512 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8514 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8516 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8517 & b1(1,itj1),auxvec(1))
8518 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8520 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8521 & b1(1,itl1),auxvec(1))
8522 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8524 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8526 vv(1)=pizda(1,1)-pizda(2,2)
8527 vv(2)=pizda(2,1)+pizda(1,2)
8528 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8530 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8532 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8535 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8538 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8541 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8543 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8545 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8549 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8551 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8554 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8556 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8564 c----------------------------------------------------------------------------
8565 double precision function eello_turn6(i,jj,kk)
8566 implicit real*8 (a-h,o-z)
8567 include 'DIMENSIONS'
8568 include 'COMMON.IOUNITS'
8569 include 'COMMON.CHAIN'
8570 include 'COMMON.DERIV'
8571 include 'COMMON.INTERACT'
8572 include 'COMMON.CONTACTS'
8573 include 'COMMON.TORSION'
8574 include 'COMMON.VAR'
8575 include 'COMMON.GEO'
8576 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8577 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8579 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8580 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8581 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8582 C the respective energy moment and not to the cluster cumulant.
8591 iti=itortyp(itype(i))
8592 itk=itortyp(itype(k))
8593 itk1=itortyp(itype(k+1))
8594 itl=itortyp(itype(l))
8595 itj=itortyp(itype(j))
8596 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8597 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8598 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8603 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8605 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8609 derx_turn(lll,kkk,iii)=0.0d0
8616 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8618 cd write (2,*) 'eello6_5',eello6_5
8620 call transpose2(AEA(1,1,1),auxmat(1,1))
8621 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8622 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8623 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8625 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8626 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8627 s2 = scalar2(b1(1,itk),vtemp1(1))
8629 call transpose2(AEA(1,1,2),atemp(1,1))
8630 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8631 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8632 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8634 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8635 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8636 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8638 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8639 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8640 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8641 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8642 ss13 = scalar2(b1(1,itk),vtemp4(1))
8643 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8645 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8651 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8652 C Derivatives in gamma(i+2)
8656 call transpose2(AEA(1,1,1),auxmatd(1,1))
8657 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8658 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8659 call transpose2(AEAderg(1,1,2),atempd(1,1))
8660 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8661 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8663 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8664 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8665 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8671 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8672 C Derivatives in gamma(i+3)
8674 call transpose2(AEA(1,1,1),auxmatd(1,1))
8675 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8676 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8677 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8679 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8680 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8681 s2d = scalar2(b1(1,itk),vtemp1d(1))
8683 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8684 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8686 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8688 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8689 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8690 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8698 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8699 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8701 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8702 & -0.5d0*ekont*(s2d+s12d)
8704 C Derivatives in gamma(i+4)
8705 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8706 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8707 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8709 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8710 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8711 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8719 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8721 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8723 C Derivatives in gamma(i+5)
8725 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8726 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8727 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8729 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8730 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8731 s2d = scalar2(b1(1,itk),vtemp1d(1))
8733 call transpose2(AEA(1,1,2),atempd(1,1))
8734 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8735 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8737 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8738 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8740 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8741 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8742 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8750 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8751 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8753 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8754 & -0.5d0*ekont*(s2d+s12d)
8756 C Cartesian derivatives
8761 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8762 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8763 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8765 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8766 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8768 s2d = scalar2(b1(1,itk),vtemp1d(1))
8770 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8771 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8772 s8d = -(atempd(1,1)+atempd(2,2))*
8773 & scalar2(cc(1,1,itl),vtemp2(1))
8775 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8777 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8778 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8785 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8788 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8792 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8793 & - 0.5d0*(s8d+s12d)
8795 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8804 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8806 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8807 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8808 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8809 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8810 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8812 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8813 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8814 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8818 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8819 cd & 16*eel_turn6_num
8821 if (j.lt.nres-1) then
8828 if (l.lt.nres-1) then
8836 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8837 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8838 cgrad ghalf=0.5d0*ggg1(ll)
8840 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8841 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8842 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8843 & +ekont*derx_turn(ll,2,1)
8844 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8845 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8846 & +ekont*derx_turn(ll,4,1)
8847 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8848 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8849 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8850 cgrad ghalf=0.5d0*ggg2(ll)
8852 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8853 & +ekont*derx_turn(ll,2,2)
8854 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8855 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8856 & +ekont*derx_turn(ll,4,2)
8857 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8858 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8859 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8864 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8869 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8875 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8880 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8884 cd write (2,*) iii,g_corr6_loc(iii)
8886 eello_turn6=ekont*eel_turn6
8887 cd write (2,*) 'ekont',ekont
8888 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8892 C-----------------------------------------------------------------------------
8893 double precision function scalar(u,v)
8894 !DIR$ INLINEALWAYS scalar
8896 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8899 double precision u(3),v(3)
8900 cd double precision sc
8908 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8911 crc-------------------------------------------------
8912 SUBROUTINE MATVEC2(A1,V1,V2)
8913 !DIR$ INLINEALWAYS MATVEC2
8915 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8917 implicit real*8 (a-h,o-z)
8918 include 'DIMENSIONS'
8919 DIMENSION A1(2,2),V1(2),V2(2)
8923 c 3 VI=VI+A1(I,K)*V1(K)
8927 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8928 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8933 C---------------------------------------
8934 SUBROUTINE MATMAT2(A1,A2,A3)
8936 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8938 implicit real*8 (a-h,o-z)
8939 include 'DIMENSIONS'
8940 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8941 c DIMENSION AI3(2,2)
8945 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8951 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8952 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8953 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8954 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8962 c-------------------------------------------------------------------------
8963 double precision function scalar2(u,v)
8964 !DIR$ INLINEALWAYS scalar2
8966 double precision u(2),v(2)
8969 scalar2=u(1)*v(1)+u(2)*v(2)
8973 C-----------------------------------------------------------------------------
8975 subroutine transpose2(a,at)
8976 !DIR$ INLINEALWAYS transpose2
8978 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8981 double precision a(2,2),at(2,2)
8988 c--------------------------------------------------------------------------
8989 subroutine transpose(n,a,at)
8992 double precision a(n,n),at(n,n)
9000 C---------------------------------------------------------------------------
9001 subroutine prodmat3(a1,a2,kk,transp,prod)
9002 !DIR$ INLINEALWAYS prodmat3
9004 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9008 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9010 crc double precision auxmat(2,2),prod_(2,2)
9013 crc call transpose2(kk(1,1),auxmat(1,1))
9014 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9015 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9017 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9018 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9019 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9020 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9021 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9022 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9023 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9024 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9027 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9028 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9030 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9031 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9032 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9033 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9034 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9035 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9036 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9037 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9040 c call transpose2(a2(1,1),a2t(1,1))
9043 crc print *,((prod_(i,j),i=1,2),j=1,2)
9044 crc print *,((prod(i,j),i=1,2),j=1,2)