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
5785 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5787 do i=iphi_start,iphi_end
5794 v1ij=v1sccor(j,itori,itori1)
5795 v2ij=v2sccor(j,itori,itori1)
5798 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5799 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5802 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5803 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5804 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5805 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5809 c----------------------------------------------------------------------------
5810 subroutine multibody(ecorr)
5811 C This subroutine calculates multi-body contributions to energy following
5812 C the idea of Skolnick et al. If side chains I and J make a contact and
5813 C at the same time side chains I+1 and J+1 make a contact, an extra
5814 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5815 implicit real*8 (a-h,o-z)
5816 include 'DIMENSIONS'
5817 include 'COMMON.IOUNITS'
5818 include 'COMMON.DERIV'
5819 include 'COMMON.INTERACT'
5820 include 'COMMON.CONTACTS'
5821 double precision gx(3),gx1(3)
5824 C Set lprn=.true. for debugging
5828 write (iout,'(a)') 'Contact function values:'
5830 write (iout,'(i2,20(1x,i2,f10.5))')
5831 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5846 num_conti=num_cont(i)
5847 num_conti1=num_cont(i1)
5852 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5853 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5854 cd & ' ishift=',ishift
5855 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5856 C The system gains extra energy.
5857 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5858 endif ! j1==j+-ishift
5867 c------------------------------------------------------------------------------
5868 double precision function esccorr(i,j,k,l,jj,kk)
5869 implicit real*8 (a-h,o-z)
5870 include 'DIMENSIONS'
5871 include 'COMMON.IOUNITS'
5872 include 'COMMON.DERIV'
5873 include 'COMMON.INTERACT'
5874 include 'COMMON.CONTACTS'
5875 double precision gx(3),gx1(3)
5880 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5881 C Calculate the multi-body contribution to energy.
5882 C Calculate multi-body contributions to the gradient.
5883 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5884 cd & k,l,(gacont(m,kk,k),m=1,3)
5886 gx(m) =ekl*gacont(m,jj,i)
5887 gx1(m)=eij*gacont(m,kk,k)
5888 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5889 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5890 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5891 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5895 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5900 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5906 c------------------------------------------------------------------------------
5907 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5908 C This subroutine calculates multi-body contributions to hydrogen-bonding
5909 implicit real*8 (a-h,o-z)
5910 include 'DIMENSIONS'
5911 include 'COMMON.IOUNITS'
5914 parameter (max_cont=maxconts)
5915 parameter (max_dim=26)
5916 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5917 double precision zapas(max_dim,maxconts,max_fg_procs),
5918 & zapas_recv(max_dim,maxconts,max_fg_procs)
5919 common /przechowalnia/ zapas
5920 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5921 & status_array(MPI_STATUS_SIZE,maxconts*2)
5923 include 'COMMON.SETUP'
5924 include 'COMMON.FFIELD'
5925 include 'COMMON.DERIV'
5926 include 'COMMON.INTERACT'
5927 include 'COMMON.CONTACTS'
5928 include 'COMMON.CONTROL'
5929 include 'COMMON.LOCAL'
5930 double precision gx(3),gx1(3),time00
5933 C Set lprn=.true. for debugging
5938 if (nfgtasks.le.1) goto 30
5940 write (iout,'(a)') 'Contact function values before RECEIVE:'
5942 write (iout,'(2i3,50(1x,i2,f5.2))')
5943 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5944 & j=1,num_cont_hb(i))
5948 do i=1,ntask_cont_from
5951 do i=1,ntask_cont_to
5954 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5956 C Make the list of contacts to send to send to other procesors
5957 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5959 do i=iturn3_start,iturn3_end
5960 c write (iout,*) "make contact list turn3",i," num_cont",
5962 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5964 do i=iturn4_start,iturn4_end
5965 c write (iout,*) "make contact list turn4",i," num_cont",
5967 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5971 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5973 do j=1,num_cont_hb(i)
5976 iproc=iint_sent_local(k,jjc,ii)
5977 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5978 if (iproc.gt.0) then
5979 ncont_sent(iproc)=ncont_sent(iproc)+1
5980 nn=ncont_sent(iproc)
5982 zapas(2,nn,iproc)=jjc
5983 zapas(3,nn,iproc)=facont_hb(j,i)
5984 zapas(4,nn,iproc)=ees0p(j,i)
5985 zapas(5,nn,iproc)=ees0m(j,i)
5986 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5987 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5988 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5989 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5990 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5991 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5992 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5993 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5994 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5995 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5996 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5997 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5998 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5999 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6000 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6001 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6002 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6003 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6004 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6005 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6006 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6013 & "Numbers of contacts to be sent to other processors",
6014 & (ncont_sent(i),i=1,ntask_cont_to)
6015 write (iout,*) "Contacts sent"
6016 do ii=1,ntask_cont_to
6018 iproc=itask_cont_to(ii)
6019 write (iout,*) nn," contacts to processor",iproc,
6020 & " of CONT_TO_COMM group"
6022 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6030 CorrelID1=nfgtasks+fg_rank+1
6032 C Receive the numbers of needed contacts from other processors
6033 do ii=1,ntask_cont_from
6034 iproc=itask_cont_from(ii)
6036 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6037 & FG_COMM,req(ireq),IERR)
6039 c write (iout,*) "IRECV ended"
6041 C Send the number of contacts needed by other processors
6042 do ii=1,ntask_cont_to
6043 iproc=itask_cont_to(ii)
6045 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6046 & FG_COMM,req(ireq),IERR)
6048 c write (iout,*) "ISEND ended"
6049 c write (iout,*) "number of requests (nn)",ireq
6052 & call MPI_Waitall(ireq,req,status_array,ierr)
6054 c & "Numbers of contacts to be received from other processors",
6055 c & (ncont_recv(i),i=1,ntask_cont_from)
6059 do ii=1,ntask_cont_from
6060 iproc=itask_cont_from(ii)
6062 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6063 c & " of CONT_TO_COMM group"
6067 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6068 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6069 c write (iout,*) "ireq,req",ireq,req(ireq)
6072 C Send the contacts to processors that need them
6073 do ii=1,ntask_cont_to
6074 iproc=itask_cont_to(ii)
6076 c write (iout,*) nn," contacts to processor",iproc,
6077 c & " of CONT_TO_COMM group"
6080 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6081 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6082 c write (iout,*) "ireq,req",ireq,req(ireq)
6084 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6088 c write (iout,*) "number of requests (contacts)",ireq
6089 c write (iout,*) "req",(req(i),i=1,4)
6092 & call MPI_Waitall(ireq,req,status_array,ierr)
6093 do iii=1,ntask_cont_from
6094 iproc=itask_cont_from(iii)
6097 write (iout,*) "Received",nn," contacts from processor",iproc,
6098 & " of CONT_FROM_COMM group"
6101 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6106 ii=zapas_recv(1,i,iii)
6107 c Flag the received contacts to prevent double-counting
6108 jj=-zapas_recv(2,i,iii)
6109 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6111 nnn=num_cont_hb(ii)+1
6114 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6115 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6116 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6117 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6118 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6119 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6120 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6121 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6122 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6123 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6124 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6125 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6126 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6127 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6128 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6129 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6130 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6131 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6132 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6133 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6134 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6135 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6136 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6137 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6142 write (iout,'(a)') 'Contact function values after receive:'
6144 write (iout,'(2i3,50(1x,i3,f5.2))')
6145 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6146 & j=1,num_cont_hb(i))
6153 write (iout,'(a)') 'Contact function values:'
6155 write (iout,'(2i3,50(1x,i3,f5.2))')
6156 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6157 & j=1,num_cont_hb(i))
6161 C Remove the loop below after debugging !!!
6168 C Calculate the local-electrostatic correlation terms
6169 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6171 num_conti=num_cont_hb(i)
6172 num_conti1=num_cont_hb(i+1)
6179 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6180 c & ' jj=',jj,' kk=',kk
6181 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6182 & .or. j.lt.0 .and. j1.gt.0) .and.
6183 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6184 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6185 C The system gains extra energy.
6186 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6187 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6188 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6190 else if (j1.eq.j) then
6191 C Contacts I-J and I-(J+1) occur simultaneously.
6192 C The system loses extra energy.
6193 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6198 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6199 c & ' jj=',jj,' kk=',kk
6201 C Contacts I-J and (I+1)-J occur simultaneously.
6202 C The system loses extra energy.
6203 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6210 c------------------------------------------------------------------------------
6211 subroutine add_hb_contact(ii,jj,itask)
6212 implicit real*8 (a-h,o-z)
6213 include "DIMENSIONS"
6214 include "COMMON.IOUNITS"
6217 parameter (max_cont=maxconts)
6218 parameter (max_dim=26)
6219 include "COMMON.CONTACTS"
6220 double precision zapas(max_dim,maxconts,max_fg_procs),
6221 & zapas_recv(max_dim,maxconts,max_fg_procs)
6222 common /przechowalnia/ zapas
6223 integer i,j,ii,jj,iproc,itask(4),nn
6224 c write (iout,*) "itask",itask
6227 if (iproc.gt.0) then
6228 do j=1,num_cont_hb(ii)
6230 c write (iout,*) "i",ii," j",jj," jjc",jjc
6232 ncont_sent(iproc)=ncont_sent(iproc)+1
6233 nn=ncont_sent(iproc)
6234 zapas(1,nn,iproc)=ii
6235 zapas(2,nn,iproc)=jjc
6236 zapas(3,nn,iproc)=facont_hb(j,ii)
6237 zapas(4,nn,iproc)=ees0p(j,ii)
6238 zapas(5,nn,iproc)=ees0m(j,ii)
6239 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6240 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6241 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6242 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6243 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6244 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6245 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6246 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6247 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6248 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6249 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6250 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6251 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6252 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6253 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6254 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6255 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6256 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6257 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6258 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6259 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6267 c------------------------------------------------------------------------------
6268 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6270 C This subroutine calculates multi-body contributions to hydrogen-bonding
6271 implicit real*8 (a-h,o-z)
6272 include 'DIMENSIONS'
6273 include 'COMMON.IOUNITS'
6276 parameter (max_cont=maxconts)
6277 parameter (max_dim=70)
6278 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6279 double precision zapas(max_dim,maxconts,max_fg_procs),
6280 & zapas_recv(max_dim,maxconts,max_fg_procs)
6281 common /przechowalnia/ zapas
6282 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6283 & status_array(MPI_STATUS_SIZE,maxconts*2)
6285 include 'COMMON.SETUP'
6286 include 'COMMON.FFIELD'
6287 include 'COMMON.DERIV'
6288 include 'COMMON.LOCAL'
6289 include 'COMMON.INTERACT'
6290 include 'COMMON.CONTACTS'
6291 include 'COMMON.CHAIN'
6292 include 'COMMON.CONTROL'
6293 double precision gx(3),gx1(3)
6294 integer num_cont_hb_old(maxres)
6296 double precision eello4,eello5,eelo6,eello_turn6
6297 external eello4,eello5,eello6,eello_turn6
6298 C Set lprn=.true. for debugging
6303 num_cont_hb_old(i)=num_cont_hb(i)
6307 if (nfgtasks.le.1) goto 30
6309 write (iout,'(a)') 'Contact function values before RECEIVE:'
6311 write (iout,'(2i3,50(1x,i2,f5.2))')
6312 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6313 & j=1,num_cont_hb(i))
6317 do i=1,ntask_cont_from
6320 do i=1,ntask_cont_to
6323 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6325 C Make the list of contacts to send to send to other procesors
6326 do i=iturn3_start,iturn3_end
6327 c write (iout,*) "make contact list turn3",i," num_cont",
6329 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6331 do i=iturn4_start,iturn4_end
6332 c write (iout,*) "make contact list turn4",i," num_cont",
6334 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6338 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6340 do j=1,num_cont_hb(i)
6343 iproc=iint_sent_local(k,jjc,ii)
6344 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6345 if (iproc.ne.0) then
6346 ncont_sent(iproc)=ncont_sent(iproc)+1
6347 nn=ncont_sent(iproc)
6349 zapas(2,nn,iproc)=jjc
6350 zapas(3,nn,iproc)=d_cont(j,i)
6354 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6359 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6367 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6378 & "Numbers of contacts to be sent to other processors",
6379 & (ncont_sent(i),i=1,ntask_cont_to)
6380 write (iout,*) "Contacts sent"
6381 do ii=1,ntask_cont_to
6383 iproc=itask_cont_to(ii)
6384 write (iout,*) nn," contacts to processor",iproc,
6385 & " of CONT_TO_COMM group"
6387 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6395 CorrelID1=nfgtasks+fg_rank+1
6397 C Receive the numbers of needed contacts from other processors
6398 do ii=1,ntask_cont_from
6399 iproc=itask_cont_from(ii)
6401 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6402 & FG_COMM,req(ireq),IERR)
6404 c write (iout,*) "IRECV ended"
6406 C Send the number of contacts needed by other processors
6407 do ii=1,ntask_cont_to
6408 iproc=itask_cont_to(ii)
6410 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6411 & FG_COMM,req(ireq),IERR)
6413 c write (iout,*) "ISEND ended"
6414 c write (iout,*) "number of requests (nn)",ireq
6417 & call MPI_Waitall(ireq,req,status_array,ierr)
6419 c & "Numbers of contacts to be received from other processors",
6420 c & (ncont_recv(i),i=1,ntask_cont_from)
6424 do ii=1,ntask_cont_from
6425 iproc=itask_cont_from(ii)
6427 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6428 c & " of CONT_TO_COMM group"
6432 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6433 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6434 c write (iout,*) "ireq,req",ireq,req(ireq)
6437 C Send the contacts to processors that need them
6438 do ii=1,ntask_cont_to
6439 iproc=itask_cont_to(ii)
6441 c write (iout,*) nn," contacts to processor",iproc,
6442 c & " of CONT_TO_COMM group"
6445 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6446 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6447 c write (iout,*) "ireq,req",ireq,req(ireq)
6449 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6453 c write (iout,*) "number of requests (contacts)",ireq
6454 c write (iout,*) "req",(req(i),i=1,4)
6457 & call MPI_Waitall(ireq,req,status_array,ierr)
6458 do iii=1,ntask_cont_from
6459 iproc=itask_cont_from(iii)
6462 write (iout,*) "Received",nn," contacts from processor",iproc,
6463 & " of CONT_FROM_COMM group"
6466 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6471 ii=zapas_recv(1,i,iii)
6472 c Flag the received contacts to prevent double-counting
6473 jj=-zapas_recv(2,i,iii)
6474 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6476 nnn=num_cont_hb(ii)+1
6479 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6483 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6488 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6496 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6505 write (iout,'(a)') 'Contact function values after receive:'
6507 write (iout,'(2i3,50(1x,i3,5f6.3))')
6508 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6509 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6516 write (iout,'(a)') 'Contact function values:'
6518 write (iout,'(2i3,50(1x,i2,5f6.3))')
6519 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6520 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6526 C Remove the loop below after debugging !!!
6533 C Calculate the dipole-dipole interaction energies
6534 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6535 do i=iatel_s,iatel_e+1
6536 num_conti=num_cont_hb(i)
6545 C Calculate the local-electrostatic correlation terms
6546 c write (iout,*) "gradcorr5 in eello5 before loop"
6548 c write (iout,'(i5,3f10.5)')
6549 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6551 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6552 c write (iout,*) "corr loop i",i
6554 num_conti=num_cont_hb(i)
6555 num_conti1=num_cont_hb(i+1)
6562 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6563 c & ' jj=',jj,' kk=',kk
6564 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6565 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6566 & .or. j.lt.0 .and. j1.gt.0) .and.
6567 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6568 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6569 C The system gains extra energy.
6571 sqd1=dsqrt(d_cont(jj,i))
6572 sqd2=dsqrt(d_cont(kk,i1))
6573 sred_geom = sqd1*sqd2
6574 IF (sred_geom.lt.cutoff_corr) THEN
6575 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6577 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6578 cd & ' jj=',jj,' kk=',kk
6579 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6580 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6582 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6583 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6586 cd write (iout,*) 'sred_geom=',sred_geom,
6587 cd & ' ekont=',ekont,' fprim=',fprimcont,
6588 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6589 cd write (iout,*) "g_contij",g_contij
6590 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6591 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6592 call calc_eello(i,jp,i+1,jp1,jj,kk)
6593 if (wcorr4.gt.0.0d0)
6594 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6595 if (energy_dec.and.wcorr4.gt.0.0d0)
6596 1 write (iout,'(a6,4i5,0pf7.3)')
6597 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6598 c write (iout,*) "gradcorr5 before eello5"
6600 c write (iout,'(i5,3f10.5)')
6601 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6603 if (wcorr5.gt.0.0d0)
6604 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6605 c write (iout,*) "gradcorr5 after eello5"
6607 c write (iout,'(i5,3f10.5)')
6608 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6610 if (energy_dec.and.wcorr5.gt.0.0d0)
6611 1 write (iout,'(a6,4i5,0pf7.3)')
6612 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6613 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6614 cd write(2,*)'ijkl',i,jp,i+1,jp1
6615 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6616 & .or. wturn6.eq.0.0d0))then
6617 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6618 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6619 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6620 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6621 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6622 cd & 'ecorr6=',ecorr6
6623 cd write (iout,'(4e15.5)') sred_geom,
6624 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6625 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6626 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6627 else if (wturn6.gt.0.0d0
6628 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6629 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6630 eturn6=eturn6+eello_turn6(i,jj,kk)
6631 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6632 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6633 cd write (2,*) 'multibody_eello:eturn6',eturn6
6642 num_cont_hb(i)=num_cont_hb_old(i)
6644 c write (iout,*) "gradcorr5 in eello5"
6646 c write (iout,'(i5,3f10.5)')
6647 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6651 c------------------------------------------------------------------------------
6652 subroutine add_hb_contact_eello(ii,jj,itask)
6653 implicit real*8 (a-h,o-z)
6654 include "DIMENSIONS"
6655 include "COMMON.IOUNITS"
6658 parameter (max_cont=maxconts)
6659 parameter (max_dim=70)
6660 include "COMMON.CONTACTS"
6661 double precision zapas(max_dim,maxconts,max_fg_procs),
6662 & zapas_recv(max_dim,maxconts,max_fg_procs)
6663 common /przechowalnia/ zapas
6664 integer i,j,ii,jj,iproc,itask(4),nn
6665 c write (iout,*) "itask",itask
6668 if (iproc.gt.0) then
6669 do j=1,num_cont_hb(ii)
6671 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6673 ncont_sent(iproc)=ncont_sent(iproc)+1
6674 nn=ncont_sent(iproc)
6675 zapas(1,nn,iproc)=ii
6676 zapas(2,nn,iproc)=jjc
6677 zapas(3,nn,iproc)=d_cont(j,ii)
6681 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6686 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6694 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6706 c------------------------------------------------------------------------------
6707 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6708 implicit real*8 (a-h,o-z)
6709 include 'DIMENSIONS'
6710 include 'COMMON.IOUNITS'
6711 include 'COMMON.DERIV'
6712 include 'COMMON.INTERACT'
6713 include 'COMMON.CONTACTS'
6714 double precision gx(3),gx1(3)
6724 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6725 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6726 C Following 4 lines for diagnostics.
6731 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6732 c & 'Contacts ',i,j,
6733 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6734 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6736 C Calculate the multi-body contribution to energy.
6737 c ecorr=ecorr+ekont*ees
6738 C Calculate multi-body contributions to the gradient.
6739 coeffpees0pij=coeffp*ees0pij
6740 coeffmees0mij=coeffm*ees0mij
6741 coeffpees0pkl=coeffp*ees0pkl
6742 coeffmees0mkl=coeffm*ees0mkl
6744 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6745 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6746 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6747 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6748 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6749 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6750 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6751 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6752 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6753 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6754 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6755 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6756 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6757 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6758 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6759 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6760 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6761 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6762 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6763 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6764 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6765 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6766 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6767 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6768 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6773 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6774 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6775 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6776 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6781 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6782 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6783 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6784 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6787 c write (iout,*) "ehbcorr",ekont*ees
6792 C---------------------------------------------------------------------------
6793 subroutine dipole(i,j,jj)
6794 implicit real*8 (a-h,o-z)
6795 include 'DIMENSIONS'
6796 include 'COMMON.IOUNITS'
6797 include 'COMMON.CHAIN'
6798 include 'COMMON.FFIELD'
6799 include 'COMMON.DERIV'
6800 include 'COMMON.INTERACT'
6801 include 'COMMON.CONTACTS'
6802 include 'COMMON.TORSION'
6803 include 'COMMON.VAR'
6804 include 'COMMON.GEO'
6805 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6807 iti1 = itortyp(itype(i+1))
6808 if (j.lt.nres-1) then
6809 itj1 = itortyp(itype(j+1))
6814 dipi(iii,1)=Ub2(iii,i)
6815 dipderi(iii)=Ub2der(iii,i)
6816 dipi(iii,2)=b1(iii,iti1)
6817 dipj(iii,1)=Ub2(iii,j)
6818 dipderj(iii)=Ub2der(iii,j)
6819 dipj(iii,2)=b1(iii,itj1)
6823 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6826 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6833 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6837 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6842 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6843 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6845 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6847 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6849 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6854 C---------------------------------------------------------------------------
6855 subroutine calc_eello(i,j,k,l,jj,kk)
6857 C This subroutine computes matrices and vectors needed to calculate
6858 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6860 implicit real*8 (a-h,o-z)
6861 include 'DIMENSIONS'
6862 include 'COMMON.IOUNITS'
6863 include 'COMMON.CHAIN'
6864 include 'COMMON.DERIV'
6865 include 'COMMON.INTERACT'
6866 include 'COMMON.CONTACTS'
6867 include 'COMMON.TORSION'
6868 include 'COMMON.VAR'
6869 include 'COMMON.GEO'
6870 include 'COMMON.FFIELD'
6871 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6872 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6875 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6876 cd & ' jj=',jj,' kk=',kk
6877 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6878 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6879 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6882 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6883 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6886 call transpose2(aa1(1,1),aa1t(1,1))
6887 call transpose2(aa2(1,1),aa2t(1,1))
6890 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6891 & aa1tder(1,1,lll,kkk))
6892 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6893 & aa2tder(1,1,lll,kkk))
6897 C parallel orientation of the two CA-CA-CA frames.
6899 iti=itortyp(itype(i))
6903 itk1=itortyp(itype(k+1))
6904 itj=itortyp(itype(j))
6905 if (l.lt.nres-1) then
6906 itl1=itortyp(itype(l+1))
6910 C A1 kernel(j+1) A2T
6912 cd write (iout,'(3f10.5,5x,3f10.5)')
6913 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6915 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6916 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6917 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6918 C Following matrices are needed only for 6-th order cumulants
6919 IF (wcorr6.gt.0.0d0) THEN
6920 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6921 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6922 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6923 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6924 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6925 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6926 & ADtEAderx(1,1,1,1,1,1))
6928 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6929 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6930 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6931 & ADtEA1derx(1,1,1,1,1,1))
6933 C End 6-th order cumulants
6936 cd write (2,*) 'In calc_eello6'
6938 cd write (2,*) 'iii=',iii
6940 cd write (2,*) 'kkk=',kkk
6942 cd write (2,'(3(2f10.5),5x)')
6943 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6948 call transpose2(EUgder(1,1,k),auxmat(1,1))
6949 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6950 call transpose2(EUg(1,1,k),auxmat(1,1))
6951 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6952 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6956 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6957 & EAEAderx(1,1,lll,kkk,iii,1))
6961 C A1T kernel(i+1) A2
6962 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6963 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6964 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6965 C Following matrices are needed only for 6-th order cumulants
6966 IF (wcorr6.gt.0.0d0) THEN
6967 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6968 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6969 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6970 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6971 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6972 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6973 & ADtEAderx(1,1,1,1,1,2))
6974 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6975 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6976 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6977 & ADtEA1derx(1,1,1,1,1,2))
6979 C End 6-th order cumulants
6980 call transpose2(EUgder(1,1,l),auxmat(1,1))
6981 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6982 call transpose2(EUg(1,1,l),auxmat(1,1))
6983 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6984 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6988 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6989 & EAEAderx(1,1,lll,kkk,iii,2))
6994 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6995 C They are needed only when the fifth- or the sixth-order cumulants are
6997 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6998 call transpose2(AEA(1,1,1),auxmat(1,1))
6999 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7000 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7001 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7002 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7003 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7004 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7005 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7006 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7007 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7008 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7009 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7010 call transpose2(AEA(1,1,2),auxmat(1,1))
7011 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7012 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7013 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7014 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7015 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7016 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7017 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7018 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7019 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7020 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7021 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7022 C Calculate the Cartesian derivatives of the vectors.
7026 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7027 call matvec2(auxmat(1,1),b1(1,iti),
7028 & AEAb1derx(1,lll,kkk,iii,1,1))
7029 call matvec2(auxmat(1,1),Ub2(1,i),
7030 & AEAb2derx(1,lll,kkk,iii,1,1))
7031 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7032 & AEAb1derx(1,lll,kkk,iii,2,1))
7033 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7034 & AEAb2derx(1,lll,kkk,iii,2,1))
7035 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7036 call matvec2(auxmat(1,1),b1(1,itj),
7037 & AEAb1derx(1,lll,kkk,iii,1,2))
7038 call matvec2(auxmat(1,1),Ub2(1,j),
7039 & AEAb2derx(1,lll,kkk,iii,1,2))
7040 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7041 & AEAb1derx(1,lll,kkk,iii,2,2))
7042 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7043 & AEAb2derx(1,lll,kkk,iii,2,2))
7050 C Antiparallel orientation of the two CA-CA-CA frames.
7052 iti=itortyp(itype(i))
7056 itk1=itortyp(itype(k+1))
7057 itl=itortyp(itype(l))
7058 itj=itortyp(itype(j))
7059 if (j.lt.nres-1) then
7060 itj1=itortyp(itype(j+1))
7064 C A2 kernel(j-1)T A1T
7065 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7066 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7067 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7068 C Following matrices are needed only for 6-th order cumulants
7069 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7070 & j.eq.i+4 .and. l.eq.i+3)) THEN
7071 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7072 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7073 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7074 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7075 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7076 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7077 & ADtEAderx(1,1,1,1,1,1))
7078 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7079 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7080 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7081 & ADtEA1derx(1,1,1,1,1,1))
7083 C End 6-th order cumulants
7084 call transpose2(EUgder(1,1,k),auxmat(1,1))
7085 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7086 call transpose2(EUg(1,1,k),auxmat(1,1))
7087 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7088 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7092 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7093 & EAEAderx(1,1,lll,kkk,iii,1))
7097 C A2T kernel(i+1)T A1
7098 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7099 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7100 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7101 C Following matrices are needed only for 6-th order cumulants
7102 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7103 & j.eq.i+4 .and. l.eq.i+3)) THEN
7104 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7105 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7106 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7107 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7108 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7109 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7110 & ADtEAderx(1,1,1,1,1,2))
7111 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7112 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7113 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7114 & ADtEA1derx(1,1,1,1,1,2))
7116 C End 6-th order cumulants
7117 call transpose2(EUgder(1,1,j),auxmat(1,1))
7118 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7119 call transpose2(EUg(1,1,j),auxmat(1,1))
7120 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7121 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7125 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7126 & EAEAderx(1,1,lll,kkk,iii,2))
7131 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7132 C They are needed only when the fifth- or the sixth-order cumulants are
7134 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7135 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7136 call transpose2(AEA(1,1,1),auxmat(1,1))
7137 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7138 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7139 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7140 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7141 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7142 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7143 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7144 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7145 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7146 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7147 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7148 call transpose2(AEA(1,1,2),auxmat(1,1))
7149 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7150 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7151 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7152 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7153 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7154 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7155 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7156 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7157 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7158 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7159 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7160 C Calculate the Cartesian derivatives of the vectors.
7164 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7165 call matvec2(auxmat(1,1),b1(1,iti),
7166 & AEAb1derx(1,lll,kkk,iii,1,1))
7167 call matvec2(auxmat(1,1),Ub2(1,i),
7168 & AEAb2derx(1,lll,kkk,iii,1,1))
7169 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7170 & AEAb1derx(1,lll,kkk,iii,2,1))
7171 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7172 & AEAb2derx(1,lll,kkk,iii,2,1))
7173 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7174 call matvec2(auxmat(1,1),b1(1,itl),
7175 & AEAb1derx(1,lll,kkk,iii,1,2))
7176 call matvec2(auxmat(1,1),Ub2(1,l),
7177 & AEAb2derx(1,lll,kkk,iii,1,2))
7178 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7179 & AEAb1derx(1,lll,kkk,iii,2,2))
7180 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7181 & AEAb2derx(1,lll,kkk,iii,2,2))
7190 C---------------------------------------------------------------------------
7191 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7192 & KK,KKderg,AKA,AKAderg,AKAderx)
7196 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7197 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7198 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7203 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7205 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7208 cd if (lprn) write (2,*) 'In kernel'
7210 cd if (lprn) write (2,*) 'kkk=',kkk
7212 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7213 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7215 cd write (2,*) 'lll=',lll
7216 cd write (2,*) 'iii=1'
7218 cd write (2,'(3(2f10.5),5x)')
7219 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7222 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7223 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7225 cd write (2,*) 'lll=',lll
7226 cd write (2,*) 'iii=2'
7228 cd write (2,'(3(2f10.5),5x)')
7229 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7236 C---------------------------------------------------------------------------
7237 double precision function eello4(i,j,k,l,jj,kk)
7238 implicit real*8 (a-h,o-z)
7239 include 'DIMENSIONS'
7240 include 'COMMON.IOUNITS'
7241 include 'COMMON.CHAIN'
7242 include 'COMMON.DERIV'
7243 include 'COMMON.INTERACT'
7244 include 'COMMON.CONTACTS'
7245 include 'COMMON.TORSION'
7246 include 'COMMON.VAR'
7247 include 'COMMON.GEO'
7248 double precision pizda(2,2),ggg1(3),ggg2(3)
7249 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7253 cd print *,'eello4:',i,j,k,l,jj,kk
7254 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7255 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7256 cold eij=facont_hb(jj,i)
7257 cold ekl=facont_hb(kk,k)
7259 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7260 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7261 gcorr_loc(k-1)=gcorr_loc(k-1)
7262 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7264 gcorr_loc(l-1)=gcorr_loc(l-1)
7265 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7267 gcorr_loc(j-1)=gcorr_loc(j-1)
7268 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7273 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7274 & -EAEAderx(2,2,lll,kkk,iii,1)
7275 cd derx(lll,kkk,iii)=0.0d0
7279 cd gcorr_loc(l-1)=0.0d0
7280 cd gcorr_loc(j-1)=0.0d0
7281 cd gcorr_loc(k-1)=0.0d0
7283 cd write (iout,*)'Contacts have occurred for peptide groups',
7284 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7285 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7286 if (j.lt.nres-1) then
7293 if (l.lt.nres-1) then
7301 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7302 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7303 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7304 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7305 cgrad ghalf=0.5d0*ggg1(ll)
7306 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7307 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7308 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7309 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7310 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7311 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7312 cgrad ghalf=0.5d0*ggg2(ll)
7313 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7314 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7315 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7316 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7317 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7318 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7322 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7327 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7332 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7337 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7341 cd write (2,*) iii,gcorr_loc(iii)
7344 cd write (2,*) 'ekont',ekont
7345 cd write (iout,*) 'eello4',ekont*eel4
7348 C---------------------------------------------------------------------------
7349 double precision function eello5(i,j,k,l,jj,kk)
7350 implicit real*8 (a-h,o-z)
7351 include 'DIMENSIONS'
7352 include 'COMMON.IOUNITS'
7353 include 'COMMON.CHAIN'
7354 include 'COMMON.DERIV'
7355 include 'COMMON.INTERACT'
7356 include 'COMMON.CONTACTS'
7357 include 'COMMON.TORSION'
7358 include 'COMMON.VAR'
7359 include 'COMMON.GEO'
7360 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7361 double precision ggg1(3),ggg2(3)
7362 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7367 C /l\ / \ \ / \ / \ / C
7368 C / \ / \ \ / \ / \ / C
7369 C j| o |l1 | o | o| o | | o |o C
7370 C \ |/k\| |/ \| / |/ \| |/ \| C
7371 C \i/ \ / \ / / \ / \ C
7373 C (I) (II) (III) (IV) C
7375 C eello5_1 eello5_2 eello5_3 eello5_4 C
7377 C Antiparallel chains C
7380 C /j\ / \ \ / \ / \ / C
7381 C / \ / \ \ / \ / \ / C
7382 C j1| o |l | o | o| o | | o |o C
7383 C \ |/k\| |/ \| / |/ \| |/ \| C
7384 C \i/ \ / \ / / \ / \ C
7386 C (I) (II) (III) (IV) C
7388 C eello5_1 eello5_2 eello5_3 eello5_4 C
7390 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7392 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7393 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7398 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7400 itk=itortyp(itype(k))
7401 itl=itortyp(itype(l))
7402 itj=itortyp(itype(j))
7407 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7408 cd & eel5_3_num,eel5_4_num)
7412 derx(lll,kkk,iii)=0.0d0
7416 cd eij=facont_hb(jj,i)
7417 cd ekl=facont_hb(kk,k)
7419 cd write (iout,*)'Contacts have occurred for peptide groups',
7420 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7422 C Contribution from the graph I.
7423 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7424 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7425 call transpose2(EUg(1,1,k),auxmat(1,1))
7426 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7427 vv(1)=pizda(1,1)-pizda(2,2)
7428 vv(2)=pizda(1,2)+pizda(2,1)
7429 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7430 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7431 C Explicit gradient in virtual-dihedral angles.
7432 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7433 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7434 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7435 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7436 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7437 vv(1)=pizda(1,1)-pizda(2,2)
7438 vv(2)=pizda(1,2)+pizda(2,1)
7439 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7440 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7441 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7442 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7443 vv(1)=pizda(1,1)-pizda(2,2)
7444 vv(2)=pizda(1,2)+pizda(2,1)
7446 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7447 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7448 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7450 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7451 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7452 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7454 C Cartesian gradient
7458 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7460 vv(1)=pizda(1,1)-pizda(2,2)
7461 vv(2)=pizda(1,2)+pizda(2,1)
7462 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7463 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7464 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7470 C Contribution from graph II
7471 call transpose2(EE(1,1,itk),auxmat(1,1))
7472 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7473 vv(1)=pizda(1,1)+pizda(2,2)
7474 vv(2)=pizda(2,1)-pizda(1,2)
7475 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7476 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7477 C Explicit gradient in virtual-dihedral angles.
7478 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7479 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7480 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7481 vv(1)=pizda(1,1)+pizda(2,2)
7482 vv(2)=pizda(2,1)-pizda(1,2)
7484 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7485 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7486 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7488 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7489 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7490 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7492 C Cartesian gradient
7496 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7498 vv(1)=pizda(1,1)+pizda(2,2)
7499 vv(2)=pizda(2,1)-pizda(1,2)
7500 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7501 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7502 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7510 C Parallel orientation
7511 C Contribution from graph III
7512 call transpose2(EUg(1,1,l),auxmat(1,1))
7513 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7514 vv(1)=pizda(1,1)-pizda(2,2)
7515 vv(2)=pizda(1,2)+pizda(2,1)
7516 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7517 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7518 C Explicit gradient in virtual-dihedral angles.
7519 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7520 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7521 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7522 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7523 vv(1)=pizda(1,1)-pizda(2,2)
7524 vv(2)=pizda(1,2)+pizda(2,1)
7525 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7526 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7527 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7528 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7529 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7530 vv(1)=pizda(1,1)-pizda(2,2)
7531 vv(2)=pizda(1,2)+pizda(2,1)
7532 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7533 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7534 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7535 C Cartesian gradient
7539 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7541 vv(1)=pizda(1,1)-pizda(2,2)
7542 vv(2)=pizda(1,2)+pizda(2,1)
7543 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7544 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7545 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7550 C Contribution from graph IV
7552 call transpose2(EE(1,1,itl),auxmat(1,1))
7553 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7554 vv(1)=pizda(1,1)+pizda(2,2)
7555 vv(2)=pizda(2,1)-pizda(1,2)
7556 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7557 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7558 C Explicit gradient in virtual-dihedral angles.
7559 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7560 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7561 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7562 vv(1)=pizda(1,1)+pizda(2,2)
7563 vv(2)=pizda(2,1)-pizda(1,2)
7564 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7565 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7566 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7567 C Cartesian gradient
7571 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7573 vv(1)=pizda(1,1)+pizda(2,2)
7574 vv(2)=pizda(2,1)-pizda(1,2)
7575 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7576 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7577 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7582 C Antiparallel orientation
7583 C Contribution from graph III
7585 call transpose2(EUg(1,1,j),auxmat(1,1))
7586 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7587 vv(1)=pizda(1,1)-pizda(2,2)
7588 vv(2)=pizda(1,2)+pizda(2,1)
7589 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7590 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7591 C Explicit gradient in virtual-dihedral angles.
7592 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7593 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7594 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7595 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7596 vv(1)=pizda(1,1)-pizda(2,2)
7597 vv(2)=pizda(1,2)+pizda(2,1)
7598 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7599 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7600 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7601 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7602 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7603 vv(1)=pizda(1,1)-pizda(2,2)
7604 vv(2)=pizda(1,2)+pizda(2,1)
7605 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7606 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7607 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7608 C Cartesian gradient
7612 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7614 vv(1)=pizda(1,1)-pizda(2,2)
7615 vv(2)=pizda(1,2)+pizda(2,1)
7616 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7617 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7618 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7623 C Contribution from graph IV
7625 call transpose2(EE(1,1,itj),auxmat(1,1))
7626 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7627 vv(1)=pizda(1,1)+pizda(2,2)
7628 vv(2)=pizda(2,1)-pizda(1,2)
7629 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7630 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7631 C Explicit gradient in virtual-dihedral angles.
7632 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7633 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7634 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7635 vv(1)=pizda(1,1)+pizda(2,2)
7636 vv(2)=pizda(2,1)-pizda(1,2)
7637 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7638 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7639 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7640 C Cartesian gradient
7644 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7646 vv(1)=pizda(1,1)+pizda(2,2)
7647 vv(2)=pizda(2,1)-pizda(1,2)
7648 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7649 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7650 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7656 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7657 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7658 cd write (2,*) 'ijkl',i,j,k,l
7659 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7660 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7662 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7663 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7664 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7665 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7666 if (j.lt.nres-1) then
7673 if (l.lt.nres-1) then
7683 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7684 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7685 C summed up outside the subrouine as for the other subroutines
7686 C handling long-range interactions. The old code is commented out
7687 C with "cgrad" to keep track of changes.
7689 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7690 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7691 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7692 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7693 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7694 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7695 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7696 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7697 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7698 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7700 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7701 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7702 cgrad ghalf=0.5d0*ggg1(ll)
7704 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7705 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7706 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7707 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7708 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7709 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7710 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7711 cgrad ghalf=0.5d0*ggg2(ll)
7713 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7714 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7715 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7716 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7717 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7718 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7723 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7724 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7729 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7730 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7736 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7741 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7745 cd write (2,*) iii,g_corr5_loc(iii)
7748 cd write (2,*) 'ekont',ekont
7749 cd write (iout,*) 'eello5',ekont*eel5
7752 c--------------------------------------------------------------------------
7753 double precision function eello6(i,j,k,l,jj,kk)
7754 implicit real*8 (a-h,o-z)
7755 include 'DIMENSIONS'
7756 include 'COMMON.IOUNITS'
7757 include 'COMMON.CHAIN'
7758 include 'COMMON.DERIV'
7759 include 'COMMON.INTERACT'
7760 include 'COMMON.CONTACTS'
7761 include 'COMMON.TORSION'
7762 include 'COMMON.VAR'
7763 include 'COMMON.GEO'
7764 include 'COMMON.FFIELD'
7765 double precision ggg1(3),ggg2(3)
7766 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7771 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7779 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7780 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7784 derx(lll,kkk,iii)=0.0d0
7788 cd eij=facont_hb(jj,i)
7789 cd ekl=facont_hb(kk,k)
7795 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7796 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7797 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7798 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7799 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7800 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7802 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7803 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7804 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7805 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7806 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7807 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7811 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7813 C If turn contributions are considered, they will be handled separately.
7814 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7815 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7816 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7817 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7818 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7819 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7820 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7822 if (j.lt.nres-1) then
7829 if (l.lt.nres-1) then
7837 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7838 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7839 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7840 cgrad ghalf=0.5d0*ggg1(ll)
7842 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7843 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7844 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7845 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7846 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7847 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7848 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7849 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7850 cgrad ghalf=0.5d0*ggg2(ll)
7851 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7853 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7854 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7855 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7856 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7857 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7858 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7863 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7864 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7869 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7870 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7876 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7881 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7885 cd write (2,*) iii,g_corr6_loc(iii)
7888 cd write (2,*) 'ekont',ekont
7889 cd write (iout,*) 'eello6',ekont*eel6
7892 c--------------------------------------------------------------------------
7893 double precision function eello6_graph1(i,j,k,l,imat,swap)
7894 implicit real*8 (a-h,o-z)
7895 include 'DIMENSIONS'
7896 include 'COMMON.IOUNITS'
7897 include 'COMMON.CHAIN'
7898 include 'COMMON.DERIV'
7899 include 'COMMON.INTERACT'
7900 include 'COMMON.CONTACTS'
7901 include 'COMMON.TORSION'
7902 include 'COMMON.VAR'
7903 include 'COMMON.GEO'
7904 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7908 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7910 C Parallel Antiparallel
7916 C \ j|/k\| / \ |/k\|l /
7921 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7922 itk=itortyp(itype(k))
7923 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7924 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7925 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7926 call transpose2(EUgC(1,1,k),auxmat(1,1))
7927 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7928 vv1(1)=pizda1(1,1)-pizda1(2,2)
7929 vv1(2)=pizda1(1,2)+pizda1(2,1)
7930 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7931 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7932 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7933 s5=scalar2(vv(1),Dtobr2(1,i))
7934 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7935 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7936 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7937 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7938 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7939 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7940 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7941 & +scalar2(vv(1),Dtobr2der(1,i)))
7942 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7943 vv1(1)=pizda1(1,1)-pizda1(2,2)
7944 vv1(2)=pizda1(1,2)+pizda1(2,1)
7945 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7946 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7948 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7949 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7950 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7951 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7952 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7954 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7955 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7956 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7957 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7958 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7960 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7961 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7962 vv1(1)=pizda1(1,1)-pizda1(2,2)
7963 vv1(2)=pizda1(1,2)+pizda1(2,1)
7964 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7965 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7966 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7967 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7976 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7977 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7978 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7979 call transpose2(EUgC(1,1,k),auxmat(1,1))
7980 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7982 vv1(1)=pizda1(1,1)-pizda1(2,2)
7983 vv1(2)=pizda1(1,2)+pizda1(2,1)
7984 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7985 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7986 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7987 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7988 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7989 s5=scalar2(vv(1),Dtobr2(1,i))
7990 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7996 c----------------------------------------------------------------------------
7997 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7998 implicit real*8 (a-h,o-z)
7999 include 'DIMENSIONS'
8000 include 'COMMON.IOUNITS'
8001 include 'COMMON.CHAIN'
8002 include 'COMMON.DERIV'
8003 include 'COMMON.INTERACT'
8004 include 'COMMON.CONTACTS'
8005 include 'COMMON.TORSION'
8006 include 'COMMON.VAR'
8007 include 'COMMON.GEO'
8009 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8010 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8013 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8015 C Parallel Antiparallel
8026 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8027 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8028 C AL 7/4/01 s1 would occur in the sixth-order moment,
8029 C but not in a cluster cumulant
8031 s1=dip(1,jj,i)*dip(1,kk,k)
8033 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8034 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8035 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8036 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8037 call transpose2(EUg(1,1,k),auxmat(1,1))
8038 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8039 vv(1)=pizda(1,1)-pizda(2,2)
8040 vv(2)=pizda(1,2)+pizda(2,1)
8041 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8042 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8044 eello6_graph2=-(s1+s2+s3+s4)
8046 eello6_graph2=-(s2+s3+s4)
8049 C Derivatives in gamma(i-1)
8052 s1=dipderg(1,jj,i)*dip(1,kk,k)
8054 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8055 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8056 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8057 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8059 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8061 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8063 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8065 C Derivatives in gamma(k-1)
8067 s1=dip(1,jj,i)*dipderg(1,kk,k)
8069 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8070 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8071 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8072 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8073 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8074 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8075 vv(1)=pizda(1,1)-pizda(2,2)
8076 vv(2)=pizda(1,2)+pizda(2,1)
8077 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8079 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8081 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8083 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8084 C Derivatives in gamma(j-1) or gamma(l-1)
8087 s1=dipderg(3,jj,i)*dip(1,kk,k)
8089 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8090 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8091 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8092 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8093 vv(1)=pizda(1,1)-pizda(2,2)
8094 vv(2)=pizda(1,2)+pizda(2,1)
8095 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8098 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8100 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8103 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8104 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8106 C Derivatives in gamma(l-1) or gamma(j-1)
8109 s1=dip(1,jj,i)*dipderg(3,kk,k)
8111 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8112 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8113 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8114 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8115 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8116 vv(1)=pizda(1,1)-pizda(2,2)
8117 vv(2)=pizda(1,2)+pizda(2,1)
8118 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8121 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8123 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8126 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8127 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8129 C Cartesian derivatives.
8131 write (2,*) 'In eello6_graph2'
8133 write (2,*) 'iii=',iii
8135 write (2,*) 'kkk=',kkk
8137 write (2,'(3(2f10.5),5x)')
8138 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8148 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8150 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8153 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8155 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8156 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8158 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8159 call transpose2(EUg(1,1,k),auxmat(1,1))
8160 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8162 vv(1)=pizda(1,1)-pizda(2,2)
8163 vv(2)=pizda(1,2)+pizda(2,1)
8164 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8165 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8167 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8169 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8172 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8174 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8181 c----------------------------------------------------------------------------
8182 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8183 implicit real*8 (a-h,o-z)
8184 include 'DIMENSIONS'
8185 include 'COMMON.IOUNITS'
8186 include 'COMMON.CHAIN'
8187 include 'COMMON.DERIV'
8188 include 'COMMON.INTERACT'
8189 include 'COMMON.CONTACTS'
8190 include 'COMMON.TORSION'
8191 include 'COMMON.VAR'
8192 include 'COMMON.GEO'
8193 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8195 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8197 C Parallel Antiparallel
8208 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8210 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8211 C energy moment and not to the cluster cumulant.
8212 iti=itortyp(itype(i))
8213 if (j.lt.nres-1) then
8214 itj1=itortyp(itype(j+1))
8218 itk=itortyp(itype(k))
8219 itk1=itortyp(itype(k+1))
8220 if (l.lt.nres-1) then
8221 itl1=itortyp(itype(l+1))
8226 s1=dip(4,jj,i)*dip(4,kk,k)
8228 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8229 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8230 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8231 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8232 call transpose2(EE(1,1,itk),auxmat(1,1))
8233 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8234 vv(1)=pizda(1,1)+pizda(2,2)
8235 vv(2)=pizda(2,1)-pizda(1,2)
8236 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8237 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8238 cd & "sum",-(s2+s3+s4)
8240 eello6_graph3=-(s1+s2+s3+s4)
8242 eello6_graph3=-(s2+s3+s4)
8245 C Derivatives in gamma(k-1)
8246 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8247 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8248 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8249 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8250 C Derivatives in gamma(l-1)
8251 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8252 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8253 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8254 vv(1)=pizda(1,1)+pizda(2,2)
8255 vv(2)=pizda(2,1)-pizda(1,2)
8256 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8257 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8258 C Cartesian derivatives.
8264 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8266 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8269 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8271 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8272 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8274 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8275 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8277 vv(1)=pizda(1,1)+pizda(2,2)
8278 vv(2)=pizda(2,1)-pizda(1,2)
8279 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8281 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8283 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8286 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8288 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8290 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8296 c----------------------------------------------------------------------------
8297 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8298 implicit real*8 (a-h,o-z)
8299 include 'DIMENSIONS'
8300 include 'COMMON.IOUNITS'
8301 include 'COMMON.CHAIN'
8302 include 'COMMON.DERIV'
8303 include 'COMMON.INTERACT'
8304 include 'COMMON.CONTACTS'
8305 include 'COMMON.TORSION'
8306 include 'COMMON.VAR'
8307 include 'COMMON.GEO'
8308 include 'COMMON.FFIELD'
8309 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8310 & auxvec1(2),auxmat1(2,2)
8312 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8314 C Parallel Antiparallel
8325 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8327 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8328 C energy moment and not to the cluster cumulant.
8329 cd write (2,*) 'eello_graph4: wturn6',wturn6
8330 iti=itortyp(itype(i))
8331 itj=itortyp(itype(j))
8332 if (j.lt.nres-1) then
8333 itj1=itortyp(itype(j+1))
8337 itk=itortyp(itype(k))
8338 if (k.lt.nres-1) then
8339 itk1=itortyp(itype(k+1))
8343 itl=itortyp(itype(l))
8344 if (l.lt.nres-1) then
8345 itl1=itortyp(itype(l+1))
8349 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8350 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8351 cd & ' itl',itl,' itl1',itl1
8354 s1=dip(3,jj,i)*dip(3,kk,k)
8356 s1=dip(2,jj,j)*dip(2,kk,l)
8359 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8360 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8362 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8363 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8365 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8366 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8368 call transpose2(EUg(1,1,k),auxmat(1,1))
8369 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8370 vv(1)=pizda(1,1)-pizda(2,2)
8371 vv(2)=pizda(2,1)+pizda(1,2)
8372 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8373 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8375 eello6_graph4=-(s1+s2+s3+s4)
8377 eello6_graph4=-(s2+s3+s4)
8379 C Derivatives in gamma(i-1)
8383 s1=dipderg(2,jj,i)*dip(3,kk,k)
8385 s1=dipderg(4,jj,j)*dip(2,kk,l)
8388 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8390 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8391 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8393 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8394 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8396 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8397 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8398 cd write (2,*) 'turn6 derivatives'
8400 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8402 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8406 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8408 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8412 C Derivatives in gamma(k-1)
8415 s1=dip(3,jj,i)*dipderg(2,kk,k)
8417 s1=dip(2,jj,j)*dipderg(4,kk,l)
8420 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8421 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8423 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8424 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8426 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8427 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8429 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8430 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8431 vv(1)=pizda(1,1)-pizda(2,2)
8432 vv(2)=pizda(2,1)+pizda(1,2)
8433 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8434 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8436 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8438 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8442 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8444 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8447 C Derivatives in gamma(j-1) or gamma(l-1)
8448 if (l.eq.j+1 .and. l.gt.1) then
8449 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8450 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8451 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8452 vv(1)=pizda(1,1)-pizda(2,2)
8453 vv(2)=pizda(2,1)+pizda(1,2)
8454 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8455 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8456 else if (j.gt.1) then
8457 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8458 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8459 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8460 vv(1)=pizda(1,1)-pizda(2,2)
8461 vv(2)=pizda(2,1)+pizda(1,2)
8462 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8463 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8464 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8466 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8469 C Cartesian derivatives.
8476 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8478 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8482 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8484 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8488 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8490 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8492 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8493 & b1(1,itj1),auxvec(1))
8494 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8496 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8497 & b1(1,itl1),auxvec(1))
8498 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8500 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8502 vv(1)=pizda(1,1)-pizda(2,2)
8503 vv(2)=pizda(2,1)+pizda(1,2)
8504 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8506 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8508 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8511 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8514 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8517 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8519 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8521 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8525 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8527 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8530 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8532 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8540 c----------------------------------------------------------------------------
8541 double precision function eello_turn6(i,jj,kk)
8542 implicit real*8 (a-h,o-z)
8543 include 'DIMENSIONS'
8544 include 'COMMON.IOUNITS'
8545 include 'COMMON.CHAIN'
8546 include 'COMMON.DERIV'
8547 include 'COMMON.INTERACT'
8548 include 'COMMON.CONTACTS'
8549 include 'COMMON.TORSION'
8550 include 'COMMON.VAR'
8551 include 'COMMON.GEO'
8552 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8553 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8555 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8556 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8557 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8558 C the respective energy moment and not to the cluster cumulant.
8567 iti=itortyp(itype(i))
8568 itk=itortyp(itype(k))
8569 itk1=itortyp(itype(k+1))
8570 itl=itortyp(itype(l))
8571 itj=itortyp(itype(j))
8572 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8573 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8574 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8579 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8581 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8585 derx_turn(lll,kkk,iii)=0.0d0
8592 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8594 cd write (2,*) 'eello6_5',eello6_5
8596 call transpose2(AEA(1,1,1),auxmat(1,1))
8597 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8598 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8599 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8601 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8602 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8603 s2 = scalar2(b1(1,itk),vtemp1(1))
8605 call transpose2(AEA(1,1,2),atemp(1,1))
8606 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8607 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8608 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8610 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8611 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8612 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8614 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8615 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8616 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8617 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8618 ss13 = scalar2(b1(1,itk),vtemp4(1))
8619 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8621 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8627 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8628 C Derivatives in gamma(i+2)
8632 call transpose2(AEA(1,1,1),auxmatd(1,1))
8633 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8634 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8635 call transpose2(AEAderg(1,1,2),atempd(1,1))
8636 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8637 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8639 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8640 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8641 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8647 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8648 C Derivatives in gamma(i+3)
8650 call transpose2(AEA(1,1,1),auxmatd(1,1))
8651 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8652 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8653 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8655 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8656 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8657 s2d = scalar2(b1(1,itk),vtemp1d(1))
8659 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8660 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8662 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8664 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8665 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8666 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8674 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8675 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8677 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8678 & -0.5d0*ekont*(s2d+s12d)
8680 C Derivatives in gamma(i+4)
8681 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8682 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8683 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8685 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8686 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8687 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8695 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8697 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8699 C Derivatives in gamma(i+5)
8701 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8702 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8703 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8705 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8706 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8707 s2d = scalar2(b1(1,itk),vtemp1d(1))
8709 call transpose2(AEA(1,1,2),atempd(1,1))
8710 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8711 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8713 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8714 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8716 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8717 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8718 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8726 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8727 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8729 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8730 & -0.5d0*ekont*(s2d+s12d)
8732 C Cartesian derivatives
8737 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8738 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8739 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8741 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8742 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8744 s2d = scalar2(b1(1,itk),vtemp1d(1))
8746 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8747 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8748 s8d = -(atempd(1,1)+atempd(2,2))*
8749 & scalar2(cc(1,1,itl),vtemp2(1))
8751 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8753 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8754 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8761 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8764 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8768 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8769 & - 0.5d0*(s8d+s12d)
8771 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8780 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8782 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8783 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8784 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8785 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8786 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8788 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8789 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8790 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8794 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8795 cd & 16*eel_turn6_num
8797 if (j.lt.nres-1) then
8804 if (l.lt.nres-1) then
8812 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8813 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8814 cgrad ghalf=0.5d0*ggg1(ll)
8816 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8817 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8818 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8819 & +ekont*derx_turn(ll,2,1)
8820 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8821 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8822 & +ekont*derx_turn(ll,4,1)
8823 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8824 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8825 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8826 cgrad ghalf=0.5d0*ggg2(ll)
8828 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8829 & +ekont*derx_turn(ll,2,2)
8830 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8831 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8832 & +ekont*derx_turn(ll,4,2)
8833 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8834 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8835 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8840 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8845 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8851 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8856 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8860 cd write (2,*) iii,g_corr6_loc(iii)
8862 eello_turn6=ekont*eel_turn6
8863 cd write (2,*) 'ekont',ekont
8864 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8868 C-----------------------------------------------------------------------------
8869 double precision function scalar(u,v)
8870 !DIR$ INLINEALWAYS scalar
8872 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8875 double precision u(3),v(3)
8876 cd double precision sc
8884 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8887 crc-------------------------------------------------
8888 SUBROUTINE MATVEC2(A1,V1,V2)
8889 !DIR$ INLINEALWAYS MATVEC2
8891 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8893 implicit real*8 (a-h,o-z)
8894 include 'DIMENSIONS'
8895 DIMENSION A1(2,2),V1(2),V2(2)
8899 c 3 VI=VI+A1(I,K)*V1(K)
8903 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8904 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8909 C---------------------------------------
8910 SUBROUTINE MATMAT2(A1,A2,A3)
8912 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8914 implicit real*8 (a-h,o-z)
8915 include 'DIMENSIONS'
8916 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8917 c DIMENSION AI3(2,2)
8921 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8927 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8928 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8929 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8930 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8938 c-------------------------------------------------------------------------
8939 double precision function scalar2(u,v)
8940 !DIR$ INLINEALWAYS scalar2
8942 double precision u(2),v(2)
8945 scalar2=u(1)*v(1)+u(2)*v(2)
8949 C-----------------------------------------------------------------------------
8951 subroutine transpose2(a,at)
8952 !DIR$ INLINEALWAYS transpose2
8954 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8957 double precision a(2,2),at(2,2)
8964 c--------------------------------------------------------------------------
8965 subroutine transpose(n,a,at)
8968 double precision a(n,n),at(n,n)
8976 C---------------------------------------------------------------------------
8977 subroutine prodmat3(a1,a2,kk,transp,prod)
8978 !DIR$ INLINEALWAYS prodmat3
8980 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8984 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8986 crc double precision auxmat(2,2),prod_(2,2)
8989 crc call transpose2(kk(1,1),auxmat(1,1))
8990 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8991 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8993 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8994 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8995 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8996 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8997 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8998 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8999 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9000 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9003 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9004 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9006 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9007 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9008 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9009 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9010 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9011 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9012 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9013 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9016 c call transpose2(a2(1,1),a2t(1,1))
9019 crc print *,((prod_(i,j),i=1,2),j=1,2)
9020 crc print *,((prod(i,j),i=1,2),j=1,2)