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
36 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
37 if (fg_rank.eq.0) then
38 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
39 c print *,"Processor",myrank," BROADCAST iorder"
40 C FG master sets up the WEIGHTS_ array which will be broadcast to the
41 C FG slaves as WEIGHTS array.
62 C FG Master broadcasts the WEIGHTS_ array
63 call MPI_Bcast(weights_(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
66 C FG slaves receive the WEIGHTS array
67 call MPI_Bcast(weights(1),n_ene,
68 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
90 time_Bcast=time_Bcast+MPI_Wtime()-time00
91 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
92 c call chainbuild_cart
94 c print *,'Processor',myrank,' calling etotal ipot=',ipot
95 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
97 c if (modecalc.eq.12.or.modecalc.eq.14) then
98 c call int_from_cart1(.false.)
109 C Compute the side-chain and electrostatic interaction energy
111 goto (101,102,103,104,105,106) ipot
112 C Lennard-Jones potential.
113 101 call elj(evdw,evdw_p,evdw_m)
114 cd print '(a)','Exit ELJ'
116 C Lennard-Jones-Kihara potential (shifted).
117 102 call eljk(evdw,evdw_p,evdw_m)
119 C Berne-Pechukas potential (dilated LJ, angular dependence).
120 103 call ebp(evdw,evdw_p,evdw_m)
122 C Gay-Berne potential (shifted LJ, angular dependence).
123 104 call egb(evdw,evdw_p,evdw_m)
125 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
126 105 call egbv(evdw,evdw_p,evdw_m)
128 C Soft-sphere potential
129 106 call e_softsphere(evdw)
131 C Calculate electrostatic (H-bonding) energy of the main chain.
135 cmc Sep-06: egb takes care of dynamic ss bonds too
137 c if (dyn_ss) call dyn_set_nss
139 c print *,"Processor",myrank," computed USCSC"
150 time_vec=time_vec+MPI_Wtime()-time01
152 time_vec=time_vec+tcpu()-time01
155 c print *,"Processor",myrank," left VEC_AND_DERIV"
158 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
159 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
160 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
161 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
163 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
164 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
165 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
166 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
168 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
177 c write (iout,*) "Soft-spheer ELEC potential"
178 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
181 c print *,"Processor",myrank," computed UELEC"
183 C Calculate excluded-volume interaction energy between peptide groups
188 call escp(evdw2,evdw2_14)
194 c write (iout,*) "Soft-sphere SCP potential"
195 call escp_soft_sphere(evdw2,evdw2_14)
198 c Calculate the bond-stretching energy
202 C Calculate the disulfide-bridge and other energy and the contributions
203 C from other distance constraints.
204 cd print *,'Calling EHPB'
206 cd print *,'EHPB exitted succesfully.'
208 C Calculate the virtual-bond-angle energy.
210 if (wang.gt.0d0) then
215 c print *,"Processor",myrank," computed UB"
217 C Calculate the SC local energy.
220 c print *,"Processor",myrank," computed USC"
222 C Calculate the virtual-bond torsional energy.
224 cd print *,'nterm=',nterm
226 call etor(etors,edihcnstr)
231 c print *,"Processor",myrank," computed Utor"
233 C 6/23/01 Calculate double-torsional energy
235 if (wtor_d.gt.0) then
240 c print *,"Processor",myrank," computed Utord"
242 C 21/5/07 Calculate local sicdechain correlation energy
244 if (wsccor.gt.0.0d0) then
245 call eback_sc_corr(esccor)
249 c print *,"Processor",myrank," computed Usccorr"
251 C 12/1/95 Multi-body terms
255 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
256 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
257 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
258 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
259 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
266 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
267 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
268 cd write (iout,*) "multibody_hb ecorr",ecorr
270 c print *,"Processor",myrank," computed Ucorr"
272 C If performing constraint dynamics, call the constraint energy
273 C after the equilibration time
274 if(usampl.and.totT.gt.eq_time) then
283 time_enecalc=time_enecalc+MPI_Wtime()-time00
285 time_enecalc=time_enecalc+tcpu()-time00
288 c print *,"Processor",myrank," computed Uconstr"
301 energia(2)=evdw2-evdw2_14
318 energia(8)=eello_turn3
319 energia(9)=eello_turn4
326 energia(19)=edihcnstr
328 energia(20)=Uconst+Uconst_back
332 c print *," Processor",myrank," calls SUM_ENERGY"
333 call sum_energy(energia,.true.)
334 if (dyn_ss) call dyn_set_nss
335 c print *," Processor",myrank," left SUM_ENERGY"
338 time_sumene=time_sumene+MPI_Wtime()-time00
340 time_sumene=time_sumene+tcpu()-time00
345 c-------------------------------------------------------------------------------
346 subroutine sum_energy(energia,reduce)
347 implicit real*8 (a-h,o-z)
352 cMS$ATTRIBUTES C :: proc_proc
358 include 'COMMON.SETUP'
359 include 'COMMON.IOUNITS'
360 double precision energia(0:n_ene),enebuff(0:n_ene+1)
361 include 'COMMON.FFIELD'
362 include 'COMMON.DERIV'
363 include 'COMMON.INTERACT'
364 include 'COMMON.SBRIDGE'
365 include 'COMMON.CHAIN'
367 include 'COMMON.CONTROL'
368 include 'COMMON.TIME1'
371 if (nfgtasks.gt.1 .and. reduce) then
373 write (iout,*) "energies before REDUCE"
374 call enerprint(energia)
378 enebuff(i)=energia(i)
381 call MPI_Barrier(FG_COMM,IERR)
382 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
384 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
385 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
387 write (iout,*) "energies after REDUCE"
388 call enerprint(energia)
391 time_Reduce=time_Reduce+MPI_Wtime()-time00
393 if (fg_rank.eq.0) then
396 evdw=energia(22)+wsct*energia(23)
401 evdw2=energia(2)+energia(18)
417 eello_turn3=energia(8)
418 eello_turn4=energia(9)
425 edihcnstr=energia(19)
430 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
431 & +wang*ebe+wtor*etors+wscloc*escloc
432 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
433 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
434 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
435 & +wbond*estr+Uconst+wsccor*esccor
437 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
438 & +wang*ebe+wtor*etors+wscloc*escloc
439 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
440 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
441 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
442 & +wbond*estr+Uconst+wsccor*esccor
448 if (isnan(etot).ne.0) energia(0)=1.0d+99
450 if (isnan(etot)) energia(0)=1.0d+99
455 idumm=proc_proc(etot,i)
457 call proc_proc(etot,i)
459 if(i.eq.1)energia(0)=1.0d+99
466 c-------------------------------------------------------------------------------
467 subroutine sum_gradient
468 implicit real*8 (a-h,o-z)
473 cMS$ATTRIBUTES C :: proc_proc
479 double precision gradbufc(3,maxres),gradbufx(3,maxres),
480 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
481 include 'COMMON.SETUP'
482 include 'COMMON.IOUNITS'
483 include 'COMMON.FFIELD'
484 include 'COMMON.DERIV'
485 include 'COMMON.INTERACT'
486 include 'COMMON.SBRIDGE'
487 include 'COMMON.CHAIN'
489 include 'COMMON.CONTROL'
490 include 'COMMON.TIME1'
491 include 'COMMON.MAXGRAD'
492 include 'COMMON.SCCOR'
501 write (iout,*) "sum_gradient gvdwc, gvdwx"
503 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
504 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
505 & (gvdwcT(j,i),j=1,3)
510 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
511 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
512 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
515 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
516 C in virtual-bond-vector coordinates
519 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
521 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
522 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
524 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
526 c write (iout,'(i5,3f10.5,2x,f10.5)')
527 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
529 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
531 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
532 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
541 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
542 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
543 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
544 & wel_loc*gel_loc_long(j,i)+
545 & wcorr*gradcorr_long(j,i)+
546 & wcorr5*gradcorr5_long(j,i)+
547 & wcorr6*gradcorr6_long(j,i)+
548 & wturn6*gcorr6_turn_long(j,i)+
555 gradbufc(j,i)=wsc*gvdwc(j,i)+
556 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
557 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
558 & wel_loc*gel_loc_long(j,i)+
559 & wcorr*gradcorr_long(j,i)+
560 & wcorr5*gradcorr5_long(j,i)+
561 & wcorr6*gradcorr6_long(j,i)+
562 & wturn6*gcorr6_turn_long(j,i)+
570 gradbufc(j,i)=wsc*gvdwc(j,i)+
571 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
572 & welec*gelc_long(j,i)+
574 & wel_loc*gel_loc_long(j,i)+
575 & wcorr*gradcorr_long(j,i)+
576 & wcorr5*gradcorr5_long(j,i)+
577 & wcorr6*gradcorr6_long(j,i)+
578 & wturn6*gcorr6_turn_long(j,i)+
584 if (nfgtasks.gt.1) then
587 write (iout,*) "gradbufc before allreduce"
589 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
595 gradbufc_sum(j,i)=gradbufc(j,i)
598 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
599 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
600 c time_reduce=time_reduce+MPI_Wtime()-time00
602 c write (iout,*) "gradbufc_sum after allreduce"
604 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
609 c time_allreduce=time_allreduce+MPI_Wtime()-time00
617 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
618 write (iout,*) (i," jgrad_start",jgrad_start(i),
619 & " jgrad_end ",jgrad_end(i),
620 & i=igrad_start,igrad_end)
623 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
624 c do not parallelize this part.
626 c do i=igrad_start,igrad_end
627 c do j=jgrad_start(i),jgrad_end(i)
629 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
634 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
638 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
642 write (iout,*) "gradbufc after summing"
644 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
651 write (iout,*) "gradbufc"
653 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
659 gradbufc_sum(j,i)=gradbufc(j,i)
664 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
668 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
673 c gradbufc(k,i)=0.0d0
677 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
682 write (iout,*) "gradbufc after summing"
684 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
692 gradbufc(k,nres)=0.0d0
697 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
698 & wel_loc*gel_loc(j,i)+
699 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
700 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
701 & wel_loc*gel_loc_long(j,i)+
702 & wcorr*gradcorr_long(j,i)+
703 & wcorr5*gradcorr5_long(j,i)+
704 & wcorr6*gradcorr6_long(j,i)+
705 & wturn6*gcorr6_turn_long(j,i))+
707 & wcorr*gradcorr(j,i)+
708 & wturn3*gcorr3_turn(j,i)+
709 & wturn4*gcorr4_turn(j,i)+
710 & wcorr5*gradcorr5(j,i)+
711 & wcorr6*gradcorr6(j,i)+
712 & wturn6*gcorr6_turn(j,i)+
713 & wsccor*gsccorc(j,i)
714 & +wscloc*gscloc(j,i)
716 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
717 & wel_loc*gel_loc(j,i)+
718 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
719 & welec*gelc_long(j,i)+
720 & wel_loc*gel_loc_long(j,i)+
721 & wcorr*gcorr_long(j,i)+
722 & wcorr5*gradcorr5_long(j,i)+
723 & wcorr6*gradcorr6_long(j,i)+
724 & wturn6*gcorr6_turn_long(j,i))+
726 & wcorr*gradcorr(j,i)+
727 & wturn3*gcorr3_turn(j,i)+
728 & wturn4*gcorr4_turn(j,i)+
729 & wcorr5*gradcorr5(j,i)+
730 & wcorr6*gradcorr6(j,i)+
731 & wturn6*gcorr6_turn(j,i)+
732 & wsccor*gsccorc(j,i)
733 & +wscloc*gscloc(j,i)
736 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
737 & wscp*gradx_scp(j,i)+
739 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
740 & wsccor*gsccorx(j,i)
741 & +wscloc*gsclocx(j,i)
743 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
745 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
746 & wsccor*gsccorx(j,i)
747 & +wscloc*gsclocx(j,i)
752 write (iout,*) "gloc before adding corr"
754 write (iout,*) i,gloc(i,icg)
758 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
759 & +wcorr5*g_corr5_loc(i)
760 & +wcorr6*g_corr6_loc(i)
761 & +wturn4*gel_loc_turn4(i)
762 & +wturn3*gel_loc_turn3(i)
763 & +wturn6*gel_loc_turn6(i)
764 & +wel_loc*gel_loc_loc(i)
767 write (iout,*) "gloc after adding corr"
769 write (iout,*) i,gloc(i,icg)
773 if (nfgtasks.gt.1) then
776 gradbufc(j,i)=gradc(j,i,icg)
777 gradbufx(j,i)=gradx(j,i,icg)
781 glocbuf(i)=gloc(i,icg)
784 write (iout,*) "gloc_sc before reduce"
787 write (iout,*) i,j,gloc_sc(j,i,icg)
793 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
797 call MPI_Barrier(FG_COMM,IERR)
798 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
800 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
801 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
802 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
803 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
804 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
805 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
806 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
807 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
808 time_reduce=time_reduce+MPI_Wtime()-time00
810 write (iout,*) "gloc_sc after reduce"
813 write (iout,*) i,j,gloc_sc(j,i,icg)
818 write (iout,*) "gloc after reduce"
820 write (iout,*) i,gloc(i,icg)
825 if (gnorm_check) then
827 c Compute the maximum elements of the gradient
837 gcorr3_turn_max=0.0d0
838 gcorr4_turn_max=0.0d0
841 gcorr6_turn_max=0.0d0
851 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
852 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
854 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
855 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
857 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
858 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
859 & gvdwc_scp_max=gvdwc_scp_norm
860 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
861 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
862 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
863 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
864 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
865 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
866 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
867 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
868 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
869 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
870 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
871 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
872 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
874 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
875 & gcorr3_turn_max=gcorr3_turn_norm
876 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
878 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
879 & gcorr4_turn_max=gcorr4_turn_norm
880 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
881 if (gradcorr5_norm.gt.gradcorr5_max)
882 & gradcorr5_max=gradcorr5_norm
883 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
884 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
885 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
887 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
888 & gcorr6_turn_max=gcorr6_turn_norm
889 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
890 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
891 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
892 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
893 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
894 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
896 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
897 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
899 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
900 if (gradx_scp_norm.gt.gradx_scp_max)
901 & gradx_scp_max=gradx_scp_norm
902 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
903 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
904 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
905 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
906 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
907 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
908 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
909 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
913 open(istat,file=statname,position="append")
915 open(istat,file=statname,access="append")
917 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
918 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
919 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
920 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
921 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
922 & gsccorx_max,gsclocx_max
924 if (gvdwc_max.gt.1.0d4) then
925 write (iout,*) "gvdwc gvdwx gradb gradbx"
927 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
928 & gradb(j,i),gradbx(j,i),j=1,3)
930 call pdbout(0.0d0,'cipiszcze',iout)
936 write (iout,*) "gradc gradx gloc"
938 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
939 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
944 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
946 time_sumgradient=time_sumgradient+tcpu()-time01
951 c-------------------------------------------------------------------------------
952 subroutine rescale_weights(t_bath)
953 implicit real*8 (a-h,o-z)
955 include 'COMMON.IOUNITS'
956 include 'COMMON.FFIELD'
957 include 'COMMON.SBRIDGE'
958 double precision kfac /2.4d0/
959 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
961 c facT=2*temp0/(t_bath+temp0)
962 if (rescale_mode.eq.0) then
968 else if (rescale_mode.eq.1) then
969 facT=kfac/(kfac-1.0d0+t_bath/temp0)
970 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
971 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
972 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
973 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
974 else if (rescale_mode.eq.2) then
980 facT=licznik/dlog(dexp(x)+dexp(-x))
981 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
982 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
983 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
984 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
986 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
987 write (*,*) "Wrong RESCALE_MODE",rescale_mode
989 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
993 welec=weights(3)*fact
994 wcorr=weights(4)*fact3
995 wcorr5=weights(5)*fact4
996 wcorr6=weights(6)*fact5
997 wel_loc=weights(7)*fact2
998 wturn3=weights(8)*fact2
999 wturn4=weights(9)*fact3
1000 wturn6=weights(10)*fact5
1001 wtor=weights(13)*fact
1002 wtor_d=weights(14)*fact2
1003 wsccor=weights(21)*fact
1006 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1010 C------------------------------------------------------------------------
1011 subroutine enerprint(energia)
1012 implicit real*8 (a-h,o-z)
1013 include 'DIMENSIONS'
1014 include 'COMMON.IOUNITS'
1015 include 'COMMON.FFIELD'
1016 include 'COMMON.SBRIDGE'
1018 double precision energia(0:n_ene)
1021 evdw=energia(22)+wsct*energia(23)
1027 evdw2=energia(2)+energia(18)
1039 eello_turn3=energia(8)
1040 eello_turn4=energia(9)
1041 eello_turn6=energia(10)
1047 edihcnstr=energia(19)
1052 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1053 & estr,wbond,ebe,wang,
1054 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1056 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1057 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1058 & edihcnstr,ebr*nss,
1060 10 format (/'Virtual-chain energies:'//
1061 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1062 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1063 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1064 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1065 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1066 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1067 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1068 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1069 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1070 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1071 & ' (SS bridges & dist. cnstr.)'/
1072 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1073 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1074 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1075 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1076 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1077 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1078 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1079 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1080 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1081 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1082 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1083 & 'ETOT= ',1pE16.6,' (total)')
1085 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1086 & estr,wbond,ebe,wang,
1087 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1089 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1090 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1091 & ebr*nss,Uconst,etot
1092 10 format (/'Virtual-chain energies:'//
1093 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1094 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1095 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1096 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1097 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1098 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1099 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1100 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1101 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1102 & ' (SS bridges & dist. cnstr.)'/
1103 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1104 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1105 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1106 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1107 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1108 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1109 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1110 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1111 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1112 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1113 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1114 & 'ETOT= ',1pE16.6,' (total)')
1118 C-----------------------------------------------------------------------
1119 subroutine elj(evdw,evdw_p,evdw_m)
1121 C This subroutine calculates the interaction energy of nonbonded side chains
1122 C assuming the LJ potential of interaction.
1124 implicit real*8 (a-h,o-z)
1125 include 'DIMENSIONS'
1126 parameter (accur=1.0d-10)
1127 include 'COMMON.GEO'
1128 include 'COMMON.VAR'
1129 include 'COMMON.LOCAL'
1130 include 'COMMON.CHAIN'
1131 include 'COMMON.DERIV'
1132 include 'COMMON.INTERACT'
1133 include 'COMMON.TORSION'
1134 include 'COMMON.SBRIDGE'
1135 include 'COMMON.NAMES'
1136 include 'COMMON.IOUNITS'
1137 include 'COMMON.CONTACTS'
1139 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1141 do i=iatsc_s,iatsc_e
1150 C Calculate SC interaction energy.
1152 do iint=1,nint_gr(i)
1153 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1154 cd & 'iend=',iend(i,iint)
1155 do j=istart(i,iint),iend(i,iint)
1160 C Change 12/1/95 to calculate four-body interactions
1161 rij=xj*xj+yj*yj+zj*zj
1163 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1164 eps0ij=eps(itypi,itypj)
1166 e1=fac*fac*aa(itypi,itypj)
1167 e2=fac*bb(itypi,itypj)
1169 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1170 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1171 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1172 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1173 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1174 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1176 if (bb(itypi,itypj).gt.0) then
1177 evdw_p=evdw_p+evdwij
1179 evdw_m=evdw_m+evdwij
1185 C Calculate the components of the gradient in DC and X
1187 fac=-rrij*(e1+evdwij)
1192 if (bb(itypi,itypj).gt.0.0d0) then
1194 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1195 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1196 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1197 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1201 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1202 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1203 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1204 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1209 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1210 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1211 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1212 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1217 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1221 C 12/1/95, revised on 5/20/97
1223 C Calculate the contact function. The ith column of the array JCONT will
1224 C contain the numbers of atoms that make contacts with the atom I (of numbers
1225 C greater than I). The arrays FACONT and GACONT will contain the values of
1226 C the contact function and its derivative.
1228 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1229 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1230 C Uncomment next line, if the correlation interactions are contact function only
1231 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1233 sigij=sigma(itypi,itypj)
1234 r0ij=rs0(itypi,itypj)
1236 C Check whether the SC's are not too far to make a contact.
1239 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1240 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1242 if (fcont.gt.0.0D0) then
1243 C If the SC-SC distance if close to sigma, apply spline.
1244 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1245 cAdam & fcont1,fprimcont1)
1246 cAdam fcont1=1.0d0-fcont1
1247 cAdam if (fcont1.gt.0.0d0) then
1248 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1249 cAdam fcont=fcont*fcont1
1251 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1252 cga eps0ij=1.0d0/dsqrt(eps0ij)
1254 cga gg(k)=gg(k)*eps0ij
1256 cga eps0ij=-evdwij*eps0ij
1257 C Uncomment for AL's type of SC correlation interactions.
1258 cadam eps0ij=-evdwij
1259 num_conti=num_conti+1
1260 jcont(num_conti,i)=j
1261 facont(num_conti,i)=fcont*eps0ij
1262 fprimcont=eps0ij*fprimcont/rij
1264 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1265 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1266 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1267 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1268 gacont(1,num_conti,i)=-fprimcont*xj
1269 gacont(2,num_conti,i)=-fprimcont*yj
1270 gacont(3,num_conti,i)=-fprimcont*zj
1271 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1272 cd write (iout,'(2i3,3f10.5)')
1273 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1279 num_cont(i)=num_conti
1283 gvdwc(j,i)=expon*gvdwc(j,i)
1284 gvdwx(j,i)=expon*gvdwx(j,i)
1287 C******************************************************************************
1291 C To save time, the factor of EXPON has been extracted from ALL components
1292 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1295 C******************************************************************************
1298 C-----------------------------------------------------------------------------
1299 subroutine eljk(evdw,evdw_p,evdw_m)
1301 C This subroutine calculates the interaction energy of nonbonded side chains
1302 C assuming the LJK potential of interaction.
1304 implicit real*8 (a-h,o-z)
1305 include 'DIMENSIONS'
1306 include 'COMMON.GEO'
1307 include 'COMMON.VAR'
1308 include 'COMMON.LOCAL'
1309 include 'COMMON.CHAIN'
1310 include 'COMMON.DERIV'
1311 include 'COMMON.INTERACT'
1312 include 'COMMON.IOUNITS'
1313 include 'COMMON.NAMES'
1316 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1318 do i=iatsc_s,iatsc_e
1325 C Calculate SC interaction energy.
1327 do iint=1,nint_gr(i)
1328 do j=istart(i,iint),iend(i,iint)
1333 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1334 fac_augm=rrij**expon
1335 e_augm=augm(itypi,itypj)*fac_augm
1336 r_inv_ij=dsqrt(rrij)
1338 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1339 fac=r_shift_inv**expon
1340 e1=fac*fac*aa(itypi,itypj)
1341 e2=fac*bb(itypi,itypj)
1343 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1344 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1345 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1346 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1347 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1348 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1349 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1351 if (bb(itypi,itypj).gt.0) then
1352 evdw_p=evdw_p+evdwij
1354 evdw_m=evdw_m+evdwij
1360 C Calculate the components of the gradient in DC and X
1362 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1367 if (bb(itypi,itypj).gt.0.0d0) then
1369 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1370 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1371 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1372 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1376 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1377 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1378 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1379 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1384 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1385 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1386 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1387 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1392 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1400 gvdwc(j,i)=expon*gvdwc(j,i)
1401 gvdwx(j,i)=expon*gvdwx(j,i)
1406 C-----------------------------------------------------------------------------
1407 subroutine ebp(evdw,evdw_p,evdw_m)
1409 C This subroutine calculates the interaction energy of nonbonded side chains
1410 C assuming the Berne-Pechukas potential of interaction.
1412 implicit real*8 (a-h,o-z)
1413 include 'DIMENSIONS'
1414 include 'COMMON.GEO'
1415 include 'COMMON.VAR'
1416 include 'COMMON.LOCAL'
1417 include 'COMMON.CHAIN'
1418 include 'COMMON.DERIV'
1419 include 'COMMON.NAMES'
1420 include 'COMMON.INTERACT'
1421 include 'COMMON.IOUNITS'
1422 include 'COMMON.CALC'
1423 common /srutu/ icall
1424 c double precision rrsave(maxdim)
1427 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1429 c if (icall.eq.0) then
1435 do i=iatsc_s,iatsc_e
1441 dxi=dc_norm(1,nres+i)
1442 dyi=dc_norm(2,nres+i)
1443 dzi=dc_norm(3,nres+i)
1444 c dsci_inv=dsc_inv(itypi)
1445 dsci_inv=vbld_inv(i+nres)
1447 C Calculate SC interaction energy.
1449 do iint=1,nint_gr(i)
1450 do j=istart(i,iint),iend(i,iint)
1452 itypj=iabs(itype(j))
1453 c dscj_inv=dsc_inv(itypj)
1454 dscj_inv=vbld_inv(j+nres)
1455 chi1=chi(itypi,itypj)
1456 chi2=chi(itypj,itypi)
1463 alf12=0.5D0*(alf1+alf2)
1464 C For diagnostics only!!!
1477 dxj=dc_norm(1,nres+j)
1478 dyj=dc_norm(2,nres+j)
1479 dzj=dc_norm(3,nres+j)
1480 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1481 cd if (icall.eq.0) then
1487 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1489 C Calculate whole angle-dependent part of epsilon and contributions
1490 C to its derivatives
1491 fac=(rrij*sigsq)**expon2
1492 e1=fac*fac*aa(itypi,itypj)
1493 e2=fac*bb(itypi,itypj)
1494 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1495 eps2der=evdwij*eps3rt
1496 eps3der=evdwij*eps2rt
1497 evdwij=evdwij*eps2rt*eps3rt
1499 if (bb(itypi,itypj).gt.0) then
1500 evdw_p=evdw_p+evdwij
1502 evdw_m=evdw_m+evdwij
1508 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1509 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1510 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1511 cd & restyp(itypi),i,restyp(itypj),j,
1512 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1513 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1514 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1517 C Calculate gradient components.
1518 e1=e1*eps1*eps2rt**2*eps3rt**2
1519 fac=-expon*(e1+evdwij)
1522 C Calculate radial part of the gradient
1526 C Calculate the angular part of the gradient and sum add the contributions
1527 C to the appropriate components of the Cartesian gradient.
1529 if (bb(itypi,itypj).gt.0) then
1543 C-----------------------------------------------------------------------------
1544 subroutine egb(evdw,evdw_p,evdw_m)
1546 C This subroutine calculates the interaction energy of nonbonded side chains
1547 C assuming the Gay-Berne potential of interaction.
1549 implicit real*8 (a-h,o-z)
1550 include 'DIMENSIONS'
1551 include 'COMMON.GEO'
1552 include 'COMMON.VAR'
1553 include 'COMMON.LOCAL'
1554 include 'COMMON.CHAIN'
1555 include 'COMMON.DERIV'
1556 include 'COMMON.NAMES'
1557 include 'COMMON.INTERACT'
1558 include 'COMMON.IOUNITS'
1559 include 'COMMON.CALC'
1560 include 'COMMON.CONTROL'
1561 include 'COMMON.SBRIDGE'
1564 ccccc energy_dec=.false.
1565 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1570 c if (icall.eq.0) lprn=.false.
1572 do i=iatsc_s,iatsc_e
1578 dxi=dc_norm(1,nres+i)
1579 dyi=dc_norm(2,nres+i)
1580 dzi=dc_norm(3,nres+i)
1581 c dsci_inv=dsc_inv(itypi)
1582 dsci_inv=vbld_inv(i+nres)
1583 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1584 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1586 C Calculate SC interaction energy.
1588 do iint=1,nint_gr(i)
1589 do j=istart(i,iint),iend(i,iint)
1590 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1591 call dyn_ssbond_ene(i,j,evdwij)
1593 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1594 & 'evdw',i,j,evdwij,' ss'
1595 C triple bond artifac removal
1596 do k=j+1,iend(i,iint)
1597 C search over all next residues
1598 if (dyn_ss_mask(k)) then
1599 C check if they are cysteins
1600 C write(iout,*) 'k=',k
1601 call triple_ssbond_ene(i,j,k,evdwij)
1602 C call the energy function that removes the artifical triple disulfide
1603 C bond the soubroutine is located in ssMD.F
1605 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1606 & 'evdw',i,j,evdwij,'tss'
1607 endif!dyn_ss_mask(k)
1613 c dscj_inv=dsc_inv(itypj)
1614 dscj_inv=vbld_inv(j+nres)
1615 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1616 c & 1.0d0/vbld(j+nres)
1617 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1618 sig0ij=sigma(itypi,itypj)
1619 chi1=chi(itypi,itypj)
1620 chi2=chi(itypj,itypi)
1627 alf12=0.5D0*(alf1+alf2)
1628 C For diagnostics only!!!
1641 dxj=dc_norm(1,nres+j)
1642 dyj=dc_norm(2,nres+j)
1643 dzj=dc_norm(3,nres+j)
1644 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1645 c write (iout,*) "j",j," dc_norm",
1646 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1647 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1649 C Calculate angle-dependent terms of energy and contributions to their
1653 sig=sig0ij*dsqrt(sigsq)
1654 rij_shift=1.0D0/rij-sig+sig0ij
1655 c for diagnostics; uncomment
1656 c rij_shift=1.2*sig0ij
1657 C I hate to put IF's in the loops, but here don't have another choice!!!!
1658 if (rij_shift.le.0.0D0) then
1660 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1661 cd & restyp(itypi),i,restyp(itypj),j,
1662 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1666 c---------------------------------------------------------------
1667 rij_shift=1.0D0/rij_shift
1668 fac=rij_shift**expon
1669 e1=fac*fac*aa(itypi,itypj)
1670 e2=fac*bb(itypi,itypj)
1671 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1672 eps2der=evdwij*eps3rt
1673 eps3der=evdwij*eps2rt
1674 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1675 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1676 evdwij=evdwij*eps2rt*eps3rt
1678 if (bb(itypi,itypj).gt.0) then
1679 evdw_p=evdw_p+evdwij
1681 evdw_m=evdw_m+evdwij
1687 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1688 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1689 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1690 & restyp(itypi),i,restyp(itypj),j,
1691 & epsi,sigm,chi1,chi2,chip1,chip2,
1692 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1693 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1697 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1700 C Calculate gradient components.
1701 e1=e1*eps1*eps2rt**2*eps3rt**2
1702 fac=-expon*(e1+evdwij)*rij_shift
1706 C Calculate the radial part of the gradient
1710 C Calculate angular part of the gradient.
1712 if (bb(itypi,itypj).gt.0) then
1724 c write (iout,*) "Number of loop steps in EGB:",ind
1725 cccc energy_dec=.false.
1728 C-----------------------------------------------------------------------------
1729 subroutine egbv(evdw,evdw_p,evdw_m)
1731 C This subroutine calculates the interaction energy of nonbonded side chains
1732 C assuming the Gay-Berne-Vorobjev potential of interaction.
1734 implicit real*8 (a-h,o-z)
1735 include 'DIMENSIONS'
1736 include 'COMMON.GEO'
1737 include 'COMMON.VAR'
1738 include 'COMMON.LOCAL'
1739 include 'COMMON.CHAIN'
1740 include 'COMMON.DERIV'
1741 include 'COMMON.NAMES'
1742 include 'COMMON.INTERACT'
1743 include 'COMMON.IOUNITS'
1744 include 'COMMON.CALC'
1745 common /srutu/ icall
1748 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1751 c if (icall.eq.0) lprn=.true.
1753 do i=iatsc_s,iatsc_e
1759 dxi=dc_norm(1,nres+i)
1760 dyi=dc_norm(2,nres+i)
1761 dzi=dc_norm(3,nres+i)
1762 c dsci_inv=dsc_inv(itypi)
1763 dsci_inv=vbld_inv(i+nres)
1765 C Calculate SC interaction energy.
1767 do iint=1,nint_gr(i)
1768 do j=istart(i,iint),iend(i,iint)
1771 c dscj_inv=dsc_inv(itypj)
1772 dscj_inv=vbld_inv(j+nres)
1773 sig0ij=sigma(itypi,itypj)
1774 r0ij=r0(itypi,itypj)
1775 chi1=chi(itypi,itypj)
1776 chi2=chi(itypj,itypi)
1783 alf12=0.5D0*(alf1+alf2)
1784 C For diagnostics only!!!
1797 dxj=dc_norm(1,nres+j)
1798 dyj=dc_norm(2,nres+j)
1799 dzj=dc_norm(3,nres+j)
1800 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1802 C Calculate angle-dependent terms of energy and contributions to their
1806 sig=sig0ij*dsqrt(sigsq)
1807 rij_shift=1.0D0/rij-sig+r0ij
1808 C I hate to put IF's in the loops, but here don't have another choice!!!!
1809 if (rij_shift.le.0.0D0) then
1814 c---------------------------------------------------------------
1815 rij_shift=1.0D0/rij_shift
1816 fac=rij_shift**expon
1817 e1=fac*fac*aa(itypi,itypj)
1818 e2=fac*bb(itypi,itypj)
1819 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1820 eps2der=evdwij*eps3rt
1821 eps3der=evdwij*eps2rt
1822 fac_augm=rrij**expon
1823 e_augm=augm(itypi,itypj)*fac_augm
1824 evdwij=evdwij*eps2rt*eps3rt
1826 if (bb(itypi,itypj).gt.0) then
1827 evdw_p=evdw_p+evdwij+e_augm
1829 evdw_m=evdw_m+evdwij+e_augm
1832 evdw=evdw+evdwij+e_augm
1835 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1836 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1837 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1838 & restyp(itypi),i,restyp(itypj),j,
1839 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1840 & chi1,chi2,chip1,chip2,
1841 & eps1,eps2rt**2,eps3rt**2,
1842 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1845 C Calculate gradient components.
1846 e1=e1*eps1*eps2rt**2*eps3rt**2
1847 fac=-expon*(e1+evdwij)*rij_shift
1849 fac=rij*fac-2*expon*rrij*e_augm
1850 C Calculate the radial part of the gradient
1854 C Calculate angular part of the gradient.
1856 if (bb(itypi,itypj).gt.0) then
1868 C-----------------------------------------------------------------------------
1869 subroutine sc_angular
1870 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1871 C om12. Called by ebp, egb, and egbv.
1873 include 'COMMON.CALC'
1874 include 'COMMON.IOUNITS'
1878 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1879 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1880 om12=dxi*dxj+dyi*dyj+dzi*dzj
1882 C Calculate eps1(om12) and its derivative in om12
1883 faceps1=1.0D0-om12*chiom12
1884 faceps1_inv=1.0D0/faceps1
1885 eps1=dsqrt(faceps1_inv)
1886 C Following variable is eps1*deps1/dom12
1887 eps1_om12=faceps1_inv*chiom12
1892 c write (iout,*) "om12",om12," eps1",eps1
1893 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1898 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1899 sigsq=1.0D0-facsig*faceps1_inv
1900 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1901 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1902 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1908 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1909 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1911 C Calculate eps2 and its derivatives in om1, om2, and om12.
1914 chipom12=chip12*om12
1915 facp=1.0D0-om12*chipom12
1917 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1918 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1919 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1920 C Following variable is the square root of eps2
1921 eps2rt=1.0D0-facp1*facp_inv
1922 C Following three variables are the derivatives of the square root of eps
1923 C in om1, om2, and om12.
1924 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1925 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1926 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1927 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1928 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1929 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1930 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1931 c & " eps2rt_om12",eps2rt_om12
1932 C Calculate whole angle-dependent part of epsilon and contributions
1933 C to its derivatives
1937 C----------------------------------------------------------------------------
1938 subroutine sc_grad_T
1939 implicit real*8 (a-h,o-z)
1940 include 'DIMENSIONS'
1941 include 'COMMON.CHAIN'
1942 include 'COMMON.DERIV'
1943 include 'COMMON.CALC'
1944 include 'COMMON.IOUNITS'
1945 double precision dcosom1(3),dcosom2(3)
1946 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1947 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1948 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1949 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1953 c eom12=evdwij*eps1_om12
1955 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1956 c & " sigder",sigder
1957 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1958 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1960 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1961 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1964 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1966 c write (iout,*) "gg",(gg(k),k=1,3)
1968 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1969 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1970 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1971 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1972 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1973 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1974 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1975 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1976 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1977 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1980 C Calculate the components of the gradient in DC and X
1984 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1988 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1989 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1994 C----------------------------------------------------------------------------
1996 implicit real*8 (a-h,o-z)
1997 include 'DIMENSIONS'
1998 include 'COMMON.CHAIN'
1999 include 'COMMON.DERIV'
2000 include 'COMMON.CALC'
2001 include 'COMMON.IOUNITS'
2002 double precision dcosom1(3),dcosom2(3)
2003 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2004 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2005 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2006 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2010 c eom12=evdwij*eps1_om12
2012 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2013 c & " sigder",sigder
2014 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2015 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2017 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2018 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2021 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2023 c write (iout,*) "gg",(gg(k),k=1,3)
2025 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2026 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2027 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2028 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2029 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2030 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2031 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2032 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2033 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2034 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2037 C Calculate the components of the gradient in DC and X
2041 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2045 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2046 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2050 C-----------------------------------------------------------------------
2051 subroutine e_softsphere(evdw)
2053 C This subroutine calculates the interaction energy of nonbonded side chains
2054 C assuming the LJ potential of interaction.
2056 implicit real*8 (a-h,o-z)
2057 include 'DIMENSIONS'
2058 parameter (accur=1.0d-10)
2059 include 'COMMON.GEO'
2060 include 'COMMON.VAR'
2061 include 'COMMON.LOCAL'
2062 include 'COMMON.CHAIN'
2063 include 'COMMON.DERIV'
2064 include 'COMMON.INTERACT'
2065 include 'COMMON.TORSION'
2066 include 'COMMON.SBRIDGE'
2067 include 'COMMON.NAMES'
2068 include 'COMMON.IOUNITS'
2069 include 'COMMON.CONTACTS'
2071 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2073 do i=iatsc_s,iatsc_e
2080 C Calculate SC interaction energy.
2082 do iint=1,nint_gr(i)
2083 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2084 cd & 'iend=',iend(i,iint)
2085 do j=istart(i,iint),iend(i,iint)
2090 rij=xj*xj+yj*yj+zj*zj
2091 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2092 r0ij=r0(itypi,itypj)
2094 c print *,i,j,r0ij,dsqrt(rij)
2095 if (rij.lt.r0ijsq) then
2096 evdwij=0.25d0*(rij-r0ijsq)**2
2104 C Calculate the components of the gradient in DC and X
2110 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2111 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2112 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2113 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2117 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2125 C--------------------------------------------------------------------------
2126 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2129 C Soft-sphere potential of p-p interaction
2131 implicit real*8 (a-h,o-z)
2132 include 'DIMENSIONS'
2133 include 'COMMON.CONTROL'
2134 include 'COMMON.IOUNITS'
2135 include 'COMMON.GEO'
2136 include 'COMMON.VAR'
2137 include 'COMMON.LOCAL'
2138 include 'COMMON.CHAIN'
2139 include 'COMMON.DERIV'
2140 include 'COMMON.INTERACT'
2141 include 'COMMON.CONTACTS'
2142 include 'COMMON.TORSION'
2143 include 'COMMON.VECTORS'
2144 include 'COMMON.FFIELD'
2146 cd write(iout,*) 'In EELEC_soft_sphere'
2153 do i=iatel_s,iatel_e
2157 xmedi=c(1,i)+0.5d0*dxi
2158 ymedi=c(2,i)+0.5d0*dyi
2159 zmedi=c(3,i)+0.5d0*dzi
2161 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2162 do j=ielstart(i),ielend(i)
2166 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2167 r0ij=rpp(iteli,itelj)
2172 xj=c(1,j)+0.5D0*dxj-xmedi
2173 yj=c(2,j)+0.5D0*dyj-ymedi
2174 zj=c(3,j)+0.5D0*dzj-zmedi
2175 rij=xj*xj+yj*yj+zj*zj
2176 if (rij.lt.r0ijsq) then
2177 evdw1ij=0.25d0*(rij-r0ijsq)**2
2185 C Calculate contributions to the Cartesian gradient.
2191 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2192 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2195 * Loop over residues i+1 thru j-1.
2199 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2204 cgrad do i=nnt,nct-1
2206 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2208 cgrad do j=i+1,nct-1
2210 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2216 c------------------------------------------------------------------------------
2217 subroutine vec_and_deriv
2218 implicit real*8 (a-h,o-z)
2219 include 'DIMENSIONS'
2223 include 'COMMON.IOUNITS'
2224 include 'COMMON.GEO'
2225 include 'COMMON.VAR'
2226 include 'COMMON.LOCAL'
2227 include 'COMMON.CHAIN'
2228 include 'COMMON.VECTORS'
2229 include 'COMMON.SETUP'
2230 include 'COMMON.TIME1'
2231 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2232 C Compute the local reference systems. For reference system (i), the
2233 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2234 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2236 do i=ivec_start,ivec_end
2240 if (i.eq.nres-1) then
2241 C Case of the last full residue
2242 C Compute the Z-axis
2243 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2244 costh=dcos(pi-theta(nres))
2245 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2249 C Compute the derivatives of uz
2251 uzder(2,1,1)=-dc_norm(3,i-1)
2252 uzder(3,1,1)= dc_norm(2,i-1)
2253 uzder(1,2,1)= dc_norm(3,i-1)
2255 uzder(3,2,1)=-dc_norm(1,i-1)
2256 uzder(1,3,1)=-dc_norm(2,i-1)
2257 uzder(2,3,1)= dc_norm(1,i-1)
2260 uzder(2,1,2)= dc_norm(3,i)
2261 uzder(3,1,2)=-dc_norm(2,i)
2262 uzder(1,2,2)=-dc_norm(3,i)
2264 uzder(3,2,2)= dc_norm(1,i)
2265 uzder(1,3,2)= dc_norm(2,i)
2266 uzder(2,3,2)=-dc_norm(1,i)
2268 C Compute the Y-axis
2271 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2273 C Compute the derivatives of uy
2276 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2277 & -dc_norm(k,i)*dc_norm(j,i-1)
2278 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2280 uyder(j,j,1)=uyder(j,j,1)-costh
2281 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2286 uygrad(l,k,j,i)=uyder(l,k,j)
2287 uzgrad(l,k,j,i)=uzder(l,k,j)
2291 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2292 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2293 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2294 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2297 C Compute the Z-axis
2298 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2299 costh=dcos(pi-theta(i+2))
2300 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2304 C Compute the derivatives of uz
2306 uzder(2,1,1)=-dc_norm(3,i+1)
2307 uzder(3,1,1)= dc_norm(2,i+1)
2308 uzder(1,2,1)= dc_norm(3,i+1)
2310 uzder(3,2,1)=-dc_norm(1,i+1)
2311 uzder(1,3,1)=-dc_norm(2,i+1)
2312 uzder(2,3,1)= dc_norm(1,i+1)
2315 uzder(2,1,2)= dc_norm(3,i)
2316 uzder(3,1,2)=-dc_norm(2,i)
2317 uzder(1,2,2)=-dc_norm(3,i)
2319 uzder(3,2,2)= dc_norm(1,i)
2320 uzder(1,3,2)= dc_norm(2,i)
2321 uzder(2,3,2)=-dc_norm(1,i)
2323 C Compute the Y-axis
2326 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2328 C Compute the derivatives of uy
2331 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2332 & -dc_norm(k,i)*dc_norm(j,i+1)
2333 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2335 uyder(j,j,1)=uyder(j,j,1)-costh
2336 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2341 uygrad(l,k,j,i)=uyder(l,k,j)
2342 uzgrad(l,k,j,i)=uzder(l,k,j)
2346 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2347 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2348 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2349 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2353 vbld_inv_temp(1)=vbld_inv(i+1)
2354 if (i.lt.nres-1) then
2355 vbld_inv_temp(2)=vbld_inv(i+2)
2357 vbld_inv_temp(2)=vbld_inv(i)
2362 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2363 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2368 #if defined(PARVEC) && defined(MPI)
2369 if (nfgtasks1.gt.1) then
2371 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2372 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2373 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2374 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2375 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2377 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2378 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2380 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2381 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2382 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2383 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2384 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2385 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2386 time_gather=time_gather+MPI_Wtime()-time00
2388 c if (fg_rank.eq.0) then
2389 c write (iout,*) "Arrays UY and UZ"
2391 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2398 C-----------------------------------------------------------------------------
2399 subroutine check_vecgrad
2400 implicit real*8 (a-h,o-z)
2401 include 'DIMENSIONS'
2402 include 'COMMON.IOUNITS'
2403 include 'COMMON.GEO'
2404 include 'COMMON.VAR'
2405 include 'COMMON.LOCAL'
2406 include 'COMMON.CHAIN'
2407 include 'COMMON.VECTORS'
2408 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2409 dimension uyt(3,maxres),uzt(3,maxres)
2410 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2411 double precision delta /1.0d-7/
2414 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2415 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2416 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2417 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2418 cd & (dc_norm(if90,i),if90=1,3)
2419 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2420 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2421 cd write(iout,'(a)')
2427 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2428 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2441 cd write (iout,*) 'i=',i
2443 erij(k)=dc_norm(k,i)
2447 dc_norm(k,i)=erij(k)
2449 dc_norm(j,i)=dc_norm(j,i)+delta
2450 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2452 c dc_norm(k,i)=dc_norm(k,i)/fac
2454 c write (iout,*) (dc_norm(k,i),k=1,3)
2455 c write (iout,*) (erij(k),k=1,3)
2458 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2459 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2460 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2461 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2463 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2464 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2465 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2468 dc_norm(k,i)=erij(k)
2471 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2472 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2473 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2474 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2475 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2476 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2477 cd write (iout,'(a)')
2482 C--------------------------------------------------------------------------
2483 subroutine set_matrices
2484 implicit real*8 (a-h,o-z)
2485 include 'DIMENSIONS'
2488 include "COMMON.SETUP"
2490 integer status(MPI_STATUS_SIZE)
2492 include 'COMMON.IOUNITS'
2493 include 'COMMON.GEO'
2494 include 'COMMON.VAR'
2495 include 'COMMON.LOCAL'
2496 include 'COMMON.CHAIN'
2497 include 'COMMON.DERIV'
2498 include 'COMMON.INTERACT'
2499 include 'COMMON.CONTACTS'
2500 include 'COMMON.TORSION'
2501 include 'COMMON.VECTORS'
2502 include 'COMMON.FFIELD'
2503 double precision auxvec(2),auxmat(2,2)
2505 C Compute the virtual-bond-torsional-angle dependent quantities needed
2506 C to calculate the el-loc multibody terms of various order.
2509 do i=ivec_start+2,ivec_end+2
2513 if (i .lt. nres+1) then
2550 if (i .gt. 3 .and. i .lt. nres+1) then
2551 obrot_der(1,i-2)=-sin1
2552 obrot_der(2,i-2)= cos1
2553 Ugder(1,1,i-2)= sin1
2554 Ugder(1,2,i-2)=-cos1
2555 Ugder(2,1,i-2)=-cos1
2556 Ugder(2,2,i-2)=-sin1
2559 obrot2_der(1,i-2)=-dwasin2
2560 obrot2_der(2,i-2)= dwacos2
2561 Ug2der(1,1,i-2)= dwasin2
2562 Ug2der(1,2,i-2)=-dwacos2
2563 Ug2der(2,1,i-2)=-dwacos2
2564 Ug2der(2,2,i-2)=-dwasin2
2566 obrot_der(1,i-2)=0.0d0
2567 obrot_der(2,i-2)=0.0d0
2568 Ugder(1,1,i-2)=0.0d0
2569 Ugder(1,2,i-2)=0.0d0
2570 Ugder(2,1,i-2)=0.0d0
2571 Ugder(2,2,i-2)=0.0d0
2572 obrot2_der(1,i-2)=0.0d0
2573 obrot2_der(2,i-2)=0.0d0
2574 Ug2der(1,1,i-2)=0.0d0
2575 Ug2der(1,2,i-2)=0.0d0
2576 Ug2der(2,1,i-2)=0.0d0
2577 Ug2der(2,2,i-2)=0.0d0
2579 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2580 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2581 iti = itortyp(itype(i-2))
2585 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2586 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2587 iti1 = itortyp(itype(i-1))
2591 cd write (iout,*) '*******i',i,' iti1',iti
2592 cd write (iout,*) 'b1',b1(:,iti)
2593 cd write (iout,*) 'b2',b2(:,iti)
2594 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2595 c if (i .gt. iatel_s+2) then
2596 if (i .gt. nnt+2) then
2597 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2598 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2599 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2601 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2602 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2603 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2604 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2605 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2616 DtUg2(l,k,i-2)=0.0d0
2620 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2621 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2623 muder(k,i-2)=Ub2der(k,i-2)
2625 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2626 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2627 iti1 = itortyp(itype(i-1))
2632 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2634 cd write (iout,*) 'mu ',mu(:,i-2)
2635 cd write (iout,*) 'mu1',mu1(:,i-2)
2636 cd write (iout,*) 'mu2',mu2(:,i-2)
2637 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2639 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2640 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2641 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2642 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2643 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2644 C Vectors and matrices dependent on a single virtual-bond dihedral.
2645 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2646 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2647 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2648 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2649 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2650 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2651 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2652 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2653 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2656 C Matrices dependent on two consecutive virtual-bond dihedrals.
2657 C The order of matrices is from left to right.
2658 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2660 c do i=max0(ivec_start,2),ivec_end
2662 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2663 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2664 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2665 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2666 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2667 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2668 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2669 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2672 #if defined(MPI) && defined(PARMAT)
2674 c if (fg_rank.eq.0) then
2675 write (iout,*) "Arrays UG and UGDER before GATHER"
2677 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2678 & ((ug(l,k,i),l=1,2),k=1,2),
2679 & ((ugder(l,k,i),l=1,2),k=1,2)
2681 write (iout,*) "Arrays UG2 and UG2DER"
2683 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2684 & ((ug2(l,k,i),l=1,2),k=1,2),
2685 & ((ug2der(l,k,i),l=1,2),k=1,2)
2687 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2689 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2690 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2691 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2693 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2695 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2696 & costab(i),sintab(i),costab2(i),sintab2(i)
2698 write (iout,*) "Array MUDER"
2700 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2704 if (nfgtasks.gt.1) then
2706 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2707 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2708 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2710 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2711 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2713 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2714 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2716 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2717 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2719 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2720 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2722 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2725 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2728 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2729 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2730 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2731 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2732 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2733 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2734 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2735 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2736 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2737 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2738 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2739 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2740 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2742 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2743 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2745 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2746 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2748 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2749 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2751 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2752 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2754 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2755 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2757 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2758 & ivec_count(fg_rank1),
2759 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2761 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2762 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2764 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2765 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2767 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2768 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2770 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2771 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2773 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2774 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2776 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2777 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2779 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2780 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2782 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2783 & ivec_count(fg_rank1),
2784 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2786 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2787 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2789 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2790 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2792 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2793 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2795 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2796 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2798 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2799 & ivec_count(fg_rank1),
2800 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2802 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2803 & ivec_count(fg_rank1),
2804 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2806 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2807 & ivec_count(fg_rank1),
2808 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2809 & MPI_MAT2,FG_COMM1,IERR)
2810 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2811 & ivec_count(fg_rank1),
2812 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2813 & MPI_MAT2,FG_COMM1,IERR)
2816 c Passes matrix info through the ring
2819 if (irecv.lt.0) irecv=nfgtasks1-1
2822 if (inext.ge.nfgtasks1) inext=0
2824 c write (iout,*) "isend",isend," irecv",irecv
2826 lensend=lentyp(isend)
2827 lenrecv=lentyp(irecv)
2828 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2829 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2830 c & MPI_ROTAT1(lensend),inext,2200+isend,
2831 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2832 c & iprev,2200+irecv,FG_COMM,status,IERR)
2833 c write (iout,*) "Gather ROTAT1"
2835 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2836 c & MPI_ROTAT2(lensend),inext,3300+isend,
2837 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2838 c & iprev,3300+irecv,FG_COMM,status,IERR)
2839 c write (iout,*) "Gather ROTAT2"
2841 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2842 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2843 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2844 & iprev,4400+irecv,FG_COMM,status,IERR)
2845 c write (iout,*) "Gather ROTAT_OLD"
2847 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2848 & MPI_PRECOMP11(lensend),inext,5500+isend,
2849 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2850 & iprev,5500+irecv,FG_COMM,status,IERR)
2851 c write (iout,*) "Gather PRECOMP11"
2853 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2854 & MPI_PRECOMP12(lensend),inext,6600+isend,
2855 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2856 & iprev,6600+irecv,FG_COMM,status,IERR)
2857 c write (iout,*) "Gather PRECOMP12"
2859 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2861 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2862 & MPI_ROTAT2(lensend),inext,7700+isend,
2863 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2864 & iprev,7700+irecv,FG_COMM,status,IERR)
2865 c write (iout,*) "Gather PRECOMP21"
2867 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2868 & MPI_PRECOMP22(lensend),inext,8800+isend,
2869 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2870 & iprev,8800+irecv,FG_COMM,status,IERR)
2871 c write (iout,*) "Gather PRECOMP22"
2873 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2874 & MPI_PRECOMP23(lensend),inext,9900+isend,
2875 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2876 & MPI_PRECOMP23(lenrecv),
2877 & iprev,9900+irecv,FG_COMM,status,IERR)
2878 c write (iout,*) "Gather PRECOMP23"
2883 if (irecv.lt.0) irecv=nfgtasks1-1
2886 time_gather=time_gather+MPI_Wtime()-time00
2889 c if (fg_rank.eq.0) then
2890 write (iout,*) "Arrays UG and UGDER"
2892 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2893 & ((ug(l,k,i),l=1,2),k=1,2),
2894 & ((ugder(l,k,i),l=1,2),k=1,2)
2896 write (iout,*) "Arrays UG2 and UG2DER"
2898 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2899 & ((ug2(l,k,i),l=1,2),k=1,2),
2900 & ((ug2der(l,k,i),l=1,2),k=1,2)
2902 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2904 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2905 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2906 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2908 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2910 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2911 & costab(i),sintab(i),costab2(i),sintab2(i)
2913 write (iout,*) "Array MUDER"
2915 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2921 cd iti = itortyp(itype(i))
2924 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2925 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2930 C--------------------------------------------------------------------------
2931 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2933 C This subroutine calculates the average interaction energy and its gradient
2934 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2935 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2936 C The potential depends both on the distance of peptide-group centers and on
2937 C the orientation of the CA-CA virtual bonds.
2939 implicit real*8 (a-h,o-z)
2943 include 'DIMENSIONS'
2944 include 'COMMON.CONTROL'
2945 include 'COMMON.SETUP'
2946 include 'COMMON.IOUNITS'
2947 include 'COMMON.GEO'
2948 include 'COMMON.VAR'
2949 include 'COMMON.LOCAL'
2950 include 'COMMON.CHAIN'
2951 include 'COMMON.DERIV'
2952 include 'COMMON.INTERACT'
2953 include 'COMMON.CONTACTS'
2954 include 'COMMON.TORSION'
2955 include 'COMMON.VECTORS'
2956 include 'COMMON.FFIELD'
2957 include 'COMMON.TIME1'
2958 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2959 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2960 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2961 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2962 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2963 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2965 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2967 double precision scal_el /1.0d0/
2969 double precision scal_el /0.5d0/
2972 C 13-go grudnia roku pamietnego...
2973 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2974 & 0.0d0,1.0d0,0.0d0,
2975 & 0.0d0,0.0d0,1.0d0/
2976 cd write(iout,*) 'In EELEC'
2978 cd write(iout,*) 'Type',i
2979 cd write(iout,*) 'B1',B1(:,i)
2980 cd write(iout,*) 'B2',B2(:,i)
2981 cd write(iout,*) 'CC',CC(:,:,i)
2982 cd write(iout,*) 'DD',DD(:,:,i)
2983 cd write(iout,*) 'EE',EE(:,:,i)
2985 cd call check_vecgrad
2987 if (icheckgrad.eq.1) then
2989 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2991 dc_norm(k,i)=dc(k,i)*fac
2993 c write (iout,*) 'i',i,' fac',fac
2996 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2997 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2998 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2999 c call vec_and_deriv
3005 time_mat=time_mat+MPI_Wtime()-time01
3009 cd write (iout,*) 'i=',i
3011 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3014 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3015 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3028 cd print '(a)','Enter EELEC'
3029 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3031 gel_loc_loc(i)=0.0d0
3036 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3038 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3040 do i=iturn3_start,iturn3_end
3044 dx_normi=dc_norm(1,i)
3045 dy_normi=dc_norm(2,i)
3046 dz_normi=dc_norm(3,i)
3047 xmedi=c(1,i)+0.5d0*dxi
3048 ymedi=c(2,i)+0.5d0*dyi
3049 zmedi=c(3,i)+0.5d0*dzi
3051 call eelecij(i,i+2,ees,evdw1,eel_loc)
3052 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3053 num_cont_hb(i)=num_conti
3055 do i=iturn4_start,iturn4_end
3059 dx_normi=dc_norm(1,i)
3060 dy_normi=dc_norm(2,i)
3061 dz_normi=dc_norm(3,i)
3062 xmedi=c(1,i)+0.5d0*dxi
3063 ymedi=c(2,i)+0.5d0*dyi
3064 zmedi=c(3,i)+0.5d0*dzi
3065 num_conti=num_cont_hb(i)
3066 call eelecij(i,i+3,ees,evdw1,eel_loc)
3067 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3068 num_cont_hb(i)=num_conti
3071 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3073 do i=iatel_s,iatel_e
3077 dx_normi=dc_norm(1,i)
3078 dy_normi=dc_norm(2,i)
3079 dz_normi=dc_norm(3,i)
3080 xmedi=c(1,i)+0.5d0*dxi
3081 ymedi=c(2,i)+0.5d0*dyi
3082 zmedi=c(3,i)+0.5d0*dzi
3083 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3084 num_conti=num_cont_hb(i)
3085 do j=ielstart(i),ielend(i)
3086 call eelecij(i,j,ees,evdw1,eel_loc)
3088 num_cont_hb(i)=num_conti
3090 c write (iout,*) "Number of loop steps in EELEC:",ind
3092 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3093 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3095 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3096 ccc eel_loc=eel_loc+eello_turn3
3097 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3100 C-------------------------------------------------------------------------------
3101 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3102 implicit real*8 (a-h,o-z)
3103 include 'DIMENSIONS'
3107 include 'COMMON.CONTROL'
3108 include 'COMMON.IOUNITS'
3109 include 'COMMON.GEO'
3110 include 'COMMON.VAR'
3111 include 'COMMON.LOCAL'
3112 include 'COMMON.CHAIN'
3113 include 'COMMON.DERIV'
3114 include 'COMMON.INTERACT'
3115 include 'COMMON.CONTACTS'
3116 include 'COMMON.TORSION'
3117 include 'COMMON.VECTORS'
3118 include 'COMMON.FFIELD'
3119 include 'COMMON.TIME1'
3120 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3121 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3122 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3123 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3124 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3125 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3127 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3129 double precision scal_el /1.0d0/
3131 double precision scal_el /0.5d0/
3134 C 13-go grudnia roku pamietnego...
3135 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3136 & 0.0d0,1.0d0,0.0d0,
3137 & 0.0d0,0.0d0,1.0d0/
3138 c time00=MPI_Wtime()
3139 cd write (iout,*) "eelecij",i,j
3143 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3144 aaa=app(iteli,itelj)
3145 bbb=bpp(iteli,itelj)
3146 ael6i=ael6(iteli,itelj)
3147 ael3i=ael3(iteli,itelj)
3151 dx_normj=dc_norm(1,j)
3152 dy_normj=dc_norm(2,j)
3153 dz_normj=dc_norm(3,j)
3154 xj=c(1,j)+0.5D0*dxj-xmedi
3155 yj=c(2,j)+0.5D0*dyj-ymedi
3156 zj=c(3,j)+0.5D0*dzj-zmedi
3157 rij=xj*xj+yj*yj+zj*zj
3163 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3164 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3165 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3166 fac=cosa-3.0D0*cosb*cosg
3168 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3169 if (j.eq.i+2) ev1=scal_el*ev1
3174 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3177 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3178 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3181 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3182 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3183 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3184 cd & xmedi,ymedi,zmedi,xj,yj,zj
3186 if (energy_dec) then
3187 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3188 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3192 C Calculate contributions to the Cartesian gradient.
3195 facvdw=-6*rrmij*(ev1+evdwij)
3196 facel=-3*rrmij*(el1+eesij)
3202 * Radial derivatives. First process both termini of the fragment (i,j)
3208 c ghalf=0.5D0*ggg(k)
3209 c gelc(k,i)=gelc(k,i)+ghalf
3210 c gelc(k,j)=gelc(k,j)+ghalf
3212 c 9/28/08 AL Gradient compotents will be summed only at the end
3214 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3215 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3218 * Loop over residues i+1 thru j-1.
3222 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3229 c ghalf=0.5D0*ggg(k)
3230 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3231 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3233 c 9/28/08 AL Gradient compotents will be summed only at the end
3235 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3236 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3239 * Loop over residues i+1 thru j-1.
3243 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3250 fac=-3*rrmij*(facvdw+facvdw+facel)
3255 * Radial derivatives. First process both termini of the fragment (i,j)
3261 c ghalf=0.5D0*ggg(k)
3262 c gelc(k,i)=gelc(k,i)+ghalf
3263 c gelc(k,j)=gelc(k,j)+ghalf
3265 c 9/28/08 AL Gradient compotents will be summed only at the end
3267 gelc_long(k,j)=gelc(k,j)+ggg(k)
3268 gelc_long(k,i)=gelc(k,i)-ggg(k)
3271 * Loop over residues i+1 thru j-1.
3275 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3278 c 9/28/08 AL Gradient compotents will be summed only at the end
3283 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3284 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3290 ecosa=2.0D0*fac3*fac1+fac4
3293 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3294 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3296 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3297 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3299 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3300 cd & (dcosg(k),k=1,3)
3302 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3305 c ghalf=0.5D0*ggg(k)
3306 c gelc(k,i)=gelc(k,i)+ghalf
3307 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3308 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3309 c gelc(k,j)=gelc(k,j)+ghalf
3310 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3311 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3315 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3320 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3321 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3323 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3324 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3325 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3326 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3328 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3329 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3330 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3332 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3333 C energy of a peptide unit is assumed in the form of a second-order
3334 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3335 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3336 C are computed for EVERY pair of non-contiguous peptide groups.
3338 if (j.lt.nres-1) then
3349 muij(kkk)=mu(k,i)*mu(l,j)
3352 cd write (iout,*) 'EELEC: i',i,' j',j
3353 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3354 cd write(iout,*) 'muij',muij
3355 ury=scalar(uy(1,i),erij)
3356 urz=scalar(uz(1,i),erij)
3357 vry=scalar(uy(1,j),erij)
3358 vrz=scalar(uz(1,j),erij)
3359 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3360 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3361 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3362 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3363 fac=dsqrt(-ael6i)*r3ij
3368 cd write (iout,'(4i5,4f10.5)')
3369 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3370 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3371 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3372 cd & uy(:,j),uz(:,j)
3373 cd write (iout,'(4f10.5)')
3374 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3375 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3376 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3377 cd write (iout,'(9f10.5/)')
3378 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3379 C Derivatives of the elements of A in virtual-bond vectors
3380 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3382 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3383 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3384 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3385 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3386 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3387 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3388 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3389 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3390 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3391 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3392 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3393 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3395 C Compute radial contributions to the gradient
3413 C Add the contributions coming from er
3416 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3417 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3418 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3419 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3422 C Derivatives in DC(i)
3423 cgrad ghalf1=0.5d0*agg(k,1)
3424 cgrad ghalf2=0.5d0*agg(k,2)
3425 cgrad ghalf3=0.5d0*agg(k,3)
3426 cgrad ghalf4=0.5d0*agg(k,4)
3427 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3428 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3429 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3430 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3431 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3432 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3433 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3434 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3435 C Derivatives in DC(i+1)
3436 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3437 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3438 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3439 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3440 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3441 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3442 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3443 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3444 C Derivatives in DC(j)
3445 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3446 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3447 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3448 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3449 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3450 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3451 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3452 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3453 C Derivatives in DC(j+1) or DC(nres-1)
3454 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3455 & -3.0d0*vryg(k,3)*ury)
3456 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3457 & -3.0d0*vrzg(k,3)*ury)
3458 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3459 & -3.0d0*vryg(k,3)*urz)
3460 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3461 & -3.0d0*vrzg(k,3)*urz)
3462 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3464 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3477 aggi(k,l)=-aggi(k,l)
3478 aggi1(k,l)=-aggi1(k,l)
3479 aggj(k,l)=-aggj(k,l)
3480 aggj1(k,l)=-aggj1(k,l)
3483 if (j.lt.nres-1) then
3489 aggi(k,l)=-aggi(k,l)
3490 aggi1(k,l)=-aggi1(k,l)
3491 aggj(k,l)=-aggj(k,l)
3492 aggj1(k,l)=-aggj1(k,l)
3503 aggi(k,l)=-aggi(k,l)
3504 aggi1(k,l)=-aggi1(k,l)
3505 aggj(k,l)=-aggj(k,l)
3506 aggj1(k,l)=-aggj1(k,l)
3511 IF (wel_loc.gt.0.0d0) THEN
3512 C Contribution to the local-electrostatic energy coming from the i-j pair
3513 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3515 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3517 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3518 & 'eelloc',i,j,eel_loc_ij
3520 eel_loc=eel_loc+eel_loc_ij
3521 C Partial derivatives in virtual-bond dihedral angles gamma
3523 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3524 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3525 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3526 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3527 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3528 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3529 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3531 ggg(l)=agg(l,1)*muij(1)+
3532 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3533 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3534 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3535 cgrad ghalf=0.5d0*ggg(l)
3536 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3537 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3541 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3544 C Remaining derivatives of eello
3546 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3547 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3548 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3549 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3550 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3551 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3552 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3553 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3556 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3557 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3558 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3559 & .and. num_conti.le.maxconts) then
3560 c write (iout,*) i,j," entered corr"
3562 C Calculate the contact function. The ith column of the array JCONT will
3563 C contain the numbers of atoms that make contacts with the atom I (of numbers
3564 C greater than I). The arrays FACONT and GACONT will contain the values of
3565 C the contact function and its derivative.
3566 c r0ij=1.02D0*rpp(iteli,itelj)
3567 c r0ij=1.11D0*rpp(iteli,itelj)
3568 r0ij=2.20D0*rpp(iteli,itelj)
3569 c r0ij=1.55D0*rpp(iteli,itelj)
3570 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3571 if (fcont.gt.0.0D0) then
3572 num_conti=num_conti+1
3573 if (num_conti.gt.maxconts) then
3574 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3575 & ' will skip next contacts for this conf.'
3577 jcont_hb(num_conti,i)=j
3578 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3579 cd & " jcont_hb",jcont_hb(num_conti,i)
3580 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3581 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3582 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3584 d_cont(num_conti,i)=rij
3585 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3586 C --- Electrostatic-interaction matrix ---
3587 a_chuj(1,1,num_conti,i)=a22
3588 a_chuj(1,2,num_conti,i)=a23
3589 a_chuj(2,1,num_conti,i)=a32
3590 a_chuj(2,2,num_conti,i)=a33
3591 C --- Gradient of rij
3593 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3600 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3601 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3602 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3603 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3604 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3609 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3610 C Calculate contact energies
3612 wij=cosa-3.0D0*cosb*cosg
3615 c fac3=dsqrt(-ael6i)/r0ij**3
3616 fac3=dsqrt(-ael6i)*r3ij
3617 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3618 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3619 if (ees0tmp.gt.0) then
3620 ees0pij=dsqrt(ees0tmp)
3624 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3625 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3626 if (ees0tmp.gt.0) then
3627 ees0mij=dsqrt(ees0tmp)
3632 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3633 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3634 C Diagnostics. Comment out or remove after debugging!
3635 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3636 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3637 c ees0m(num_conti,i)=0.0D0
3639 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3640 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3641 C Angular derivatives of the contact function
3642 ees0pij1=fac3/ees0pij
3643 ees0mij1=fac3/ees0mij
3644 fac3p=-3.0D0*fac3*rrmij
3645 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3646 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3648 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3649 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3650 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3651 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3652 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3653 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3654 ecosap=ecosa1+ecosa2
3655 ecosbp=ecosb1+ecosb2
3656 ecosgp=ecosg1+ecosg2
3657 ecosam=ecosa1-ecosa2
3658 ecosbm=ecosb1-ecosb2
3659 ecosgm=ecosg1-ecosg2
3668 facont_hb(num_conti,i)=fcont
3669 fprimcont=fprimcont/rij
3670 cd facont_hb(num_conti,i)=1.0D0
3671 C Following line is for diagnostics.
3674 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3675 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3678 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3679 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3681 gggp(1)=gggp(1)+ees0pijp*xj
3682 gggp(2)=gggp(2)+ees0pijp*yj
3683 gggp(3)=gggp(3)+ees0pijp*zj
3684 gggm(1)=gggm(1)+ees0mijp*xj
3685 gggm(2)=gggm(2)+ees0mijp*yj
3686 gggm(3)=gggm(3)+ees0mijp*zj
3687 C Derivatives due to the contact function
3688 gacont_hbr(1,num_conti,i)=fprimcont*xj
3689 gacont_hbr(2,num_conti,i)=fprimcont*yj
3690 gacont_hbr(3,num_conti,i)=fprimcont*zj
3693 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3694 c following the change of gradient-summation algorithm.
3696 cgrad ghalfp=0.5D0*gggp(k)
3697 cgrad ghalfm=0.5D0*gggm(k)
3698 gacontp_hb1(k,num_conti,i)=!ghalfp
3699 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3700 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3701 gacontp_hb2(k,num_conti,i)=!ghalfp
3702 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3703 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3704 gacontp_hb3(k,num_conti,i)=gggp(k)
3705 gacontm_hb1(k,num_conti,i)=!ghalfm
3706 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3707 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3708 gacontm_hb2(k,num_conti,i)=!ghalfm
3709 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3710 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3711 gacontm_hb3(k,num_conti,i)=gggm(k)
3713 C Diagnostics. Comment out or remove after debugging!
3715 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3716 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3717 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3718 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3719 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3720 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3723 endif ! num_conti.le.maxconts
3726 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3729 ghalf=0.5d0*agg(l,k)
3730 aggi(l,k)=aggi(l,k)+ghalf
3731 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3732 aggj(l,k)=aggj(l,k)+ghalf
3735 if (j.eq.nres-1 .and. i.lt.j-2) then
3738 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3743 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3746 C-----------------------------------------------------------------------------
3747 subroutine eturn3(i,eello_turn3)
3748 C Third- and fourth-order contributions from turns
3749 implicit real*8 (a-h,o-z)
3750 include 'DIMENSIONS'
3751 include 'COMMON.IOUNITS'
3752 include 'COMMON.GEO'
3753 include 'COMMON.VAR'
3754 include 'COMMON.LOCAL'
3755 include 'COMMON.CHAIN'
3756 include 'COMMON.DERIV'
3757 include 'COMMON.INTERACT'
3758 include 'COMMON.CONTACTS'
3759 include 'COMMON.TORSION'
3760 include 'COMMON.VECTORS'
3761 include 'COMMON.FFIELD'
3762 include 'COMMON.CONTROL'
3764 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3765 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3766 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3767 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3768 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3769 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3770 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3773 c write (iout,*) "eturn3",i,j,j1,j2
3778 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3780 C Third-order contributions
3787 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3788 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3789 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3790 call transpose2(auxmat(1,1),auxmat1(1,1))
3791 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3792 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3793 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3794 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3795 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3796 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3797 cd & ' eello_turn3_num',4*eello_turn3_num
3798 C Derivatives in gamma(i)
3799 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3800 call transpose2(auxmat2(1,1),auxmat3(1,1))
3801 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3802 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3803 C Derivatives in gamma(i+1)
3804 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3805 call transpose2(auxmat2(1,1),auxmat3(1,1))
3806 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3807 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3808 & +0.5d0*(pizda(1,1)+pizda(2,2))
3809 C Cartesian derivatives
3811 c ghalf1=0.5d0*agg(l,1)
3812 c ghalf2=0.5d0*agg(l,2)
3813 c ghalf3=0.5d0*agg(l,3)
3814 c ghalf4=0.5d0*agg(l,4)
3815 a_temp(1,1)=aggi(l,1)!+ghalf1
3816 a_temp(1,2)=aggi(l,2)!+ghalf2
3817 a_temp(2,1)=aggi(l,3)!+ghalf3
3818 a_temp(2,2)=aggi(l,4)!+ghalf4
3819 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3820 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3821 & +0.5d0*(pizda(1,1)+pizda(2,2))
3822 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3823 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3824 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3825 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3826 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3827 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3828 & +0.5d0*(pizda(1,1)+pizda(2,2))
3829 a_temp(1,1)=aggj(l,1)!+ghalf1
3830 a_temp(1,2)=aggj(l,2)!+ghalf2
3831 a_temp(2,1)=aggj(l,3)!+ghalf3
3832 a_temp(2,2)=aggj(l,4)!+ghalf4
3833 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3834 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3835 & +0.5d0*(pizda(1,1)+pizda(2,2))
3836 a_temp(1,1)=aggj1(l,1)
3837 a_temp(1,2)=aggj1(l,2)
3838 a_temp(2,1)=aggj1(l,3)
3839 a_temp(2,2)=aggj1(l,4)
3840 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3841 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3842 & +0.5d0*(pizda(1,1)+pizda(2,2))
3846 C-------------------------------------------------------------------------------
3847 subroutine eturn4(i,eello_turn4)
3848 C Third- and fourth-order contributions from turns
3849 implicit real*8 (a-h,o-z)
3850 include 'DIMENSIONS'
3851 include 'COMMON.IOUNITS'
3852 include 'COMMON.GEO'
3853 include 'COMMON.VAR'
3854 include 'COMMON.LOCAL'
3855 include 'COMMON.CHAIN'
3856 include 'COMMON.DERIV'
3857 include 'COMMON.INTERACT'
3858 include 'COMMON.CONTACTS'
3859 include 'COMMON.TORSION'
3860 include 'COMMON.VECTORS'
3861 include 'COMMON.FFIELD'
3862 include 'COMMON.CONTROL'
3864 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3865 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3866 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3867 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3868 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3869 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3870 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3873 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3875 C Fourth-order contributions
3883 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3884 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3885 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3890 iti1=itortyp(itype(i+1))
3891 iti2=itortyp(itype(i+2))
3892 iti3=itortyp(itype(i+3))
3893 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3894 call transpose2(EUg(1,1,i+1),e1t(1,1))
3895 call transpose2(Eug(1,1,i+2),e2t(1,1))
3896 call transpose2(Eug(1,1,i+3),e3t(1,1))
3897 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3898 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3899 s1=scalar2(b1(1,iti2),auxvec(1))
3900 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3901 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3902 s2=scalar2(b1(1,iti1),auxvec(1))
3903 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3904 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3905 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3906 eello_turn4=eello_turn4-(s1+s2+s3)
3907 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3908 & 'eturn4',i,j,-(s1+s2+s3)
3909 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3910 cd & ' eello_turn4_num',8*eello_turn4_num
3911 C Derivatives in gamma(i)
3912 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3913 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3914 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,iti2),auxvec(1))
3916 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3917 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3918 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3919 C Derivatives in gamma(i+1)
3920 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3921 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3922 s2=scalar2(b1(1,iti1),auxvec(1))
3923 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3924 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3925 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3926 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3927 C Derivatives in gamma(i+2)
3928 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3929 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3930 s1=scalar2(b1(1,iti2),auxvec(1))
3931 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3932 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3933 s2=scalar2(b1(1,iti1),auxvec(1))
3934 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3935 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3936 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3937 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3938 C Cartesian derivatives
3939 C Derivatives of this turn contributions in DC(i+2)
3940 if (j.lt.nres-1) then
3942 a_temp(1,1)=agg(l,1)
3943 a_temp(1,2)=agg(l,2)
3944 a_temp(2,1)=agg(l,3)
3945 a_temp(2,2)=agg(l,4)
3946 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3947 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3948 s1=scalar2(b1(1,iti2),auxvec(1))
3949 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3950 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3951 s2=scalar2(b1(1,iti1),auxvec(1))
3952 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3953 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3954 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3956 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3959 C Remaining derivatives of this turn contribution
3961 a_temp(1,1)=aggi(l,1)
3962 a_temp(1,2)=aggi(l,2)
3963 a_temp(2,1)=aggi(l,3)
3964 a_temp(2,2)=aggi(l,4)
3965 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3966 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3967 s1=scalar2(b1(1,iti2),auxvec(1))
3968 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3969 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3970 s2=scalar2(b1(1,iti1),auxvec(1))
3971 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3972 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3973 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3974 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3975 a_temp(1,1)=aggi1(l,1)
3976 a_temp(1,2)=aggi1(l,2)
3977 a_temp(2,1)=aggi1(l,3)
3978 a_temp(2,2)=aggi1(l,4)
3979 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3980 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3981 s1=scalar2(b1(1,iti2),auxvec(1))
3982 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3983 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3984 s2=scalar2(b1(1,iti1),auxvec(1))
3985 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3986 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3987 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3988 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3989 a_temp(1,1)=aggj(l,1)
3990 a_temp(1,2)=aggj(l,2)
3991 a_temp(2,1)=aggj(l,3)
3992 a_temp(2,2)=aggj(l,4)
3993 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3994 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3995 s1=scalar2(b1(1,iti2),auxvec(1))
3996 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3997 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3998 s2=scalar2(b1(1,iti1),auxvec(1))
3999 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4000 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4001 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4002 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4003 a_temp(1,1)=aggj1(l,1)
4004 a_temp(1,2)=aggj1(l,2)
4005 a_temp(2,1)=aggj1(l,3)
4006 a_temp(2,2)=aggj1(l,4)
4007 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4008 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4009 s1=scalar2(b1(1,iti2),auxvec(1))
4010 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4011 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4012 s2=scalar2(b1(1,iti1),auxvec(1))
4013 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4014 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4015 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4016 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4017 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4021 C-----------------------------------------------------------------------------
4022 subroutine vecpr(u,v,w)
4023 implicit real*8(a-h,o-z)
4024 dimension u(3),v(3),w(3)
4025 w(1)=u(2)*v(3)-u(3)*v(2)
4026 w(2)=-u(1)*v(3)+u(3)*v(1)
4027 w(3)=u(1)*v(2)-u(2)*v(1)
4030 C-----------------------------------------------------------------------------
4031 subroutine unormderiv(u,ugrad,unorm,ungrad)
4032 C This subroutine computes the derivatives of a normalized vector u, given
4033 C the derivatives computed without normalization conditions, ugrad. Returns
4036 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4037 double precision vec(3)
4038 double precision scalar
4040 c write (2,*) 'ugrad',ugrad
4043 vec(i)=scalar(ugrad(1,i),u(1))
4045 c write (2,*) 'vec',vec
4048 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4051 c write (2,*) 'ungrad',ungrad
4054 C-----------------------------------------------------------------------------
4055 subroutine escp_soft_sphere(evdw2,evdw2_14)
4057 C This subroutine calculates the excluded-volume interaction energy between
4058 C peptide-group centers and side chains and its gradient in virtual-bond and
4059 C side-chain vectors.
4061 implicit real*8 (a-h,o-z)
4062 include 'DIMENSIONS'
4063 include 'COMMON.GEO'
4064 include 'COMMON.VAR'
4065 include 'COMMON.LOCAL'
4066 include 'COMMON.CHAIN'
4067 include 'COMMON.DERIV'
4068 include 'COMMON.INTERACT'
4069 include 'COMMON.FFIELD'
4070 include 'COMMON.IOUNITS'
4071 include 'COMMON.CONTROL'
4076 cd print '(a)','Enter ESCP'
4077 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4078 do i=iatscp_s,iatscp_e
4080 xi=0.5D0*(c(1,i)+c(1,i+1))
4081 yi=0.5D0*(c(2,i)+c(2,i+1))
4082 zi=0.5D0*(c(3,i)+c(3,i+1))
4084 do iint=1,nscp_gr(i)
4086 do j=iscpstart(i,iint),iscpend(i,iint)
4088 C Uncomment following three lines for SC-p interactions
4092 C Uncomment following three lines for Ca-p interactions
4096 rij=xj*xj+yj*yj+zj*zj
4099 if (rij.lt.r0ijsq) then
4100 evdwij=0.25d0*(rij-r0ijsq)**2
4108 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4113 cgrad if (j.lt.i) then
4114 cd write (iout,*) 'j<i'
4115 C Uncomment following three lines for SC-p interactions
4117 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4120 cd write (iout,*) 'j>i'
4122 cgrad ggg(k)=-ggg(k)
4123 C Uncomment following line for SC-p interactions
4124 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4128 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4130 cgrad kstart=min0(i+1,j)
4131 cgrad kend=max0(i-1,j-1)
4132 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4133 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4134 cgrad do k=kstart,kend
4136 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4140 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4141 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4149 C-----------------------------------------------------------------------------
4150 subroutine escp(evdw2,evdw2_14)
4152 C This subroutine calculates the excluded-volume interaction energy between
4153 C peptide-group centers and side chains and its gradient in virtual-bond and
4154 C side-chain vectors.
4156 implicit real*8 (a-h,o-z)
4157 include 'DIMENSIONS'
4158 include 'COMMON.GEO'
4159 include 'COMMON.VAR'
4160 include 'COMMON.LOCAL'
4161 include 'COMMON.CHAIN'
4162 include 'COMMON.DERIV'
4163 include 'COMMON.INTERACT'
4164 include 'COMMON.FFIELD'
4165 include 'COMMON.IOUNITS'
4166 include 'COMMON.CONTROL'
4170 cd print '(a)','Enter ESCP'
4171 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4172 do i=iatscp_s,iatscp_e
4174 xi=0.5D0*(c(1,i)+c(1,i+1))
4175 yi=0.5D0*(c(2,i)+c(2,i+1))
4176 zi=0.5D0*(c(3,i)+c(3,i+1))
4178 do iint=1,nscp_gr(i)
4180 do j=iscpstart(i,iint),iscpend(i,iint)
4182 C Uncomment following three lines for SC-p interactions
4186 C Uncomment following three lines for Ca-p interactions
4190 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4192 e1=fac*fac*aad(itypj,iteli)
4193 e2=fac*bad(itypj,iteli)
4194 if (iabs(j-i) .le. 2) then
4197 evdw2_14=evdw2_14+e1+e2
4201 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4202 & 'evdw2',i,j,evdwij
4204 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4206 fac=-(evdwij+e1)*rrij
4210 cgrad if (j.lt.i) then
4211 cd write (iout,*) 'j<i'
4212 C Uncomment following three lines for SC-p interactions
4214 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4217 cd write (iout,*) 'j>i'
4219 cgrad ggg(k)=-ggg(k)
4220 C Uncomment following line for SC-p interactions
4221 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4222 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4226 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4228 cgrad kstart=min0(i+1,j)
4229 cgrad kend=max0(i-1,j-1)
4230 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4231 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4232 cgrad do k=kstart,kend
4234 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4238 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4239 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4247 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4248 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4249 gradx_scp(j,i)=expon*gradx_scp(j,i)
4252 C******************************************************************************
4256 C To save time the factor EXPON has been extracted from ALL components
4257 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4260 C******************************************************************************
4263 C--------------------------------------------------------------------------
4264 subroutine edis(ehpb)
4266 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4268 implicit real*8 (a-h,o-z)
4269 include 'DIMENSIONS'
4270 include 'COMMON.SBRIDGE'
4271 include 'COMMON.CHAIN'
4272 include 'COMMON.DERIV'
4273 include 'COMMON.VAR'
4274 include 'COMMON.INTERACT'
4275 include 'COMMON.IOUNITS'
4278 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4279 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4280 if (link_end.eq.0) return
4281 do i=link_start,link_end
4282 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4283 C CA-CA distance used in regularization of structure.
4286 C iii and jjj point to the residues for which the distance is assigned.
4287 if (ii.gt.nres) then
4294 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4295 c & dhpb(i),dhpb1(i),forcon(i)
4296 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4297 C distance and angle dependent SS bond potential.
4298 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4299 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4300 if (.not.dyn_ss .and. i.le.nss) then
4301 C 15/02/13 CC dynamic SSbond - additional check
4303 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4304 call ssbond_ene(iii,jjj,eij)
4307 cd write (iout,*) "eij",eij
4308 else if (ii.gt.nres .and. jj.gt.nres) then
4309 c Restraints from contact prediction
4311 if (dhpb1(i).gt.0.0d0) then
4312 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4313 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4314 c write (iout,*) "beta nmr",
4315 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4319 C Get the force constant corresponding to this distance.
4321 C Calculate the contribution to energy.
4322 ehpb=ehpb+waga*rdis*rdis
4323 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4325 C Evaluate gradient.
4330 ggg(j)=fac*(c(j,jj)-c(j,ii))
4333 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4334 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4337 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4338 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4341 C Calculate the distance between the two points and its difference from the
4344 if (dhpb1(i).gt.0.0d0) then
4345 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4346 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4347 c write (iout,*) "alph nmr",
4348 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4351 C Get the force constant corresponding to this distance.
4353 C Calculate the contribution to energy.
4354 ehpb=ehpb+waga*rdis*rdis
4355 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4357 C Evaluate gradient.
4361 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4362 cd & ' waga=',waga,' fac=',fac
4364 ggg(j)=fac*(c(j,jj)-c(j,ii))
4366 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4367 C If this is a SC-SC distance, we need to calculate the contributions to the
4368 C Cartesian gradient in the SC vectors (ghpbx).
4371 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4372 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4375 cgrad do j=iii,jjj-1
4377 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4381 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4382 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4389 C--------------------------------------------------------------------------
4390 subroutine ssbond_ene(i,j,eij)
4392 C Calculate the distance and angle dependent SS-bond potential energy
4393 C using a free-energy function derived based on RHF/6-31G** ab initio
4394 C calculations of diethyl disulfide.
4396 C A. Liwo and U. Kozlowska, 11/24/03
4398 implicit real*8 (a-h,o-z)
4399 include 'DIMENSIONS'
4400 include 'COMMON.SBRIDGE'
4401 include 'COMMON.CHAIN'
4402 include 'COMMON.DERIV'
4403 include 'COMMON.LOCAL'
4404 include 'COMMON.INTERACT'
4405 include 'COMMON.VAR'
4406 include 'COMMON.IOUNITS'
4407 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4412 dxi=dc_norm(1,nres+i)
4413 dyi=dc_norm(2,nres+i)
4414 dzi=dc_norm(3,nres+i)
4415 c dsci_inv=dsc_inv(itypi)
4416 dsci_inv=vbld_inv(nres+i)
4418 c dscj_inv=dsc_inv(itypj)
4419 dscj_inv=vbld_inv(nres+j)
4423 dxj=dc_norm(1,nres+j)
4424 dyj=dc_norm(2,nres+j)
4425 dzj=dc_norm(3,nres+j)
4426 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4431 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4432 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4433 om12=dxi*dxj+dyi*dyj+dzi*dzj
4435 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4436 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4442 deltat12=om2-om1+2.0d0
4444 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4445 & +akct*deltad*deltat12+ebr
4446 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4447 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4448 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4449 c & " deltat12",deltat12," eij",eij
4450 ed=2*akcm*deltad+akct*deltat12
4452 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4453 eom1=-2*akth*deltat1-pom1-om2*pom2
4454 eom2= 2*akth*deltat2+pom1-om1*pom2
4457 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4458 ghpbx(k,i)=ghpbx(k,i)-ggk
4459 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4460 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4461 ghpbx(k,j)=ghpbx(k,j)+ggk
4462 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4463 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4464 ghpbc(k,i)=ghpbc(k,i)-ggk
4465 ghpbc(k,j)=ghpbc(k,j)+ggk
4468 C Calculate the components of the gradient in DC and X
4472 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4477 C--------------------------------------------------------------------------
4478 subroutine ebond(estr)
4480 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4482 implicit real*8 (a-h,o-z)
4483 include 'DIMENSIONS'
4484 include 'COMMON.LOCAL'
4485 include 'COMMON.GEO'
4486 include 'COMMON.INTERACT'
4487 include 'COMMON.DERIV'
4488 include 'COMMON.VAR'
4489 include 'COMMON.CHAIN'
4490 include 'COMMON.IOUNITS'
4491 include 'COMMON.NAMES'
4492 include 'COMMON.FFIELD'
4493 include 'COMMON.CONTROL'
4494 include 'COMMON.SETUP'
4495 double precision u(3),ud(3)
4497 do i=ibondp_start,ibondp_end
4498 diff = vbld(i)-vbldp0
4499 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4502 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4504 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4508 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4510 do i=ibond_start,ibond_end
4515 diff=vbld(i+nres)-vbldsc0(1,iti)
4516 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4517 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4518 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4520 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4524 diff=vbld(i+nres)-vbldsc0(j,iti)
4525 ud(j)=aksc(j,iti)*diff
4526 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4540 uprod2=uprod2*u(k)*u(k)
4544 usumsqder=usumsqder+ud(j)*uprod2
4546 estr=estr+uprod/usum
4548 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4556 C--------------------------------------------------------------------------
4557 subroutine ebend(etheta)
4559 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4560 C angles gamma and its derivatives in consecutive thetas and gammas.
4562 implicit real*8 (a-h,o-z)
4563 include 'DIMENSIONS'
4564 include 'COMMON.LOCAL'
4565 include 'COMMON.GEO'
4566 include 'COMMON.INTERACT'
4567 include 'COMMON.DERIV'
4568 include 'COMMON.VAR'
4569 include 'COMMON.CHAIN'
4570 include 'COMMON.IOUNITS'
4571 include 'COMMON.NAMES'
4572 include 'COMMON.FFIELD'
4573 include 'COMMON.CONTROL'
4574 common /calcthet/ term1,term2,termm,diffak,ratak,
4575 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4576 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4577 double precision y(2),z(2)
4579 c time11=dexp(-2*time)
4582 c write (*,'(a,i2)') 'EBEND ICG=',icg
4583 do i=ithet_start,ithet_end
4584 C Zero the energy function and its derivative at 0 or pi.
4585 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4587 ichir1=isign(1,itype(i-2))
4588 ichir2=isign(1,itype(i))
4589 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4590 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4591 if (itype(i-1).eq.10) then
4592 itype1=isign(10,itype(i-2))
4593 ichir11=isign(1,itype(i-2))
4594 ichir12=isign(1,itype(i-2))
4595 itype2=isign(10,itype(i))
4596 ichir21=isign(1,itype(i))
4597 ichir22=isign(1,itype(i))
4602 if (phii.ne.phii) phii=150.0
4615 if (phii1.ne.phii1) phii1=150.0
4627 C Calculate the "mean" value of theta from the part of the distribution
4628 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4629 C In following comments this theta will be referred to as t_c.
4630 thet_pred_mean=0.0d0
4632 athetk=athet(k,it,ichir1,ichir2)
4633 bthetk=bthet(k,it,ichir1,ichir2)
4635 athetk=athet(k,itype1,ichir11,ichir12)
4636 bthetk=bthet(k,itype2,ichir21,ichir22)
4638 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4640 dthett=thet_pred_mean*ssd
4641 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4642 C Derivatives of the "mean" values in gamma1 and gamma2.
4643 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4644 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4645 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4646 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4648 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4649 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4650 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4651 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4653 if (theta(i).gt.pi-delta) then
4654 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4656 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4657 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4658 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4660 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4662 else if (theta(i).lt.delta) then
4663 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4664 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4665 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4667 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4668 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4671 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4674 etheta=etheta+ethetai
4675 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4677 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4678 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4679 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4681 C Ufff.... We've done all this!!!
4684 C---------------------------------------------------------------------------
4685 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4687 implicit real*8 (a-h,o-z)
4688 include 'DIMENSIONS'
4689 include 'COMMON.LOCAL'
4690 include 'COMMON.IOUNITS'
4691 common /calcthet/ term1,term2,termm,diffak,ratak,
4692 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4693 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4694 C Calculate the contributions to both Gaussian lobes.
4695 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4696 C The "polynomial part" of the "standard deviation" of this part of
4700 sig=sig*thet_pred_mean+polthet(j,it)
4702 C Derivative of the "interior part" of the "standard deviation of the"
4703 C gamma-dependent Gaussian lobe in t_c.
4704 sigtc=3*polthet(3,it)
4706 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4709 C Set the parameters of both Gaussian lobes of the distribution.
4710 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4711 fac=sig*sig+sigc0(it)
4714 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4715 sigsqtc=-4.0D0*sigcsq*sigtc
4716 c print *,i,sig,sigtc,sigsqtc
4717 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4718 sigtc=-sigtc/(fac*fac)
4719 C Following variable is sigma(t_c)**(-2)
4720 sigcsq=sigcsq*sigcsq
4722 sig0inv=1.0D0/sig0i**2
4723 delthec=thetai-thet_pred_mean
4724 delthe0=thetai-theta0i
4725 term1=-0.5D0*sigcsq*delthec*delthec
4726 term2=-0.5D0*sig0inv*delthe0*delthe0
4727 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4728 C NaNs in taking the logarithm. We extract the largest exponent which is added
4729 C to the energy (this being the log of the distribution) at the end of energy
4730 C term evaluation for this virtual-bond angle.
4731 if (term1.gt.term2) then
4733 term2=dexp(term2-termm)
4737 term1=dexp(term1-termm)
4740 C The ratio between the gamma-independent and gamma-dependent lobes of
4741 C the distribution is a Gaussian function of thet_pred_mean too.
4742 diffak=gthet(2,it)-thet_pred_mean
4743 ratak=diffak/gthet(3,it)**2
4744 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4745 C Let's differentiate it in thet_pred_mean NOW.
4747 C Now put together the distribution terms to make complete distribution.
4748 termexp=term1+ak*term2
4749 termpre=sigc+ak*sig0i
4750 C Contribution of the bending energy from this theta is just the -log of
4751 C the sum of the contributions from the two lobes and the pre-exponential
4752 C factor. Simple enough, isn't it?
4753 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4754 C NOW the derivatives!!!
4755 C 6/6/97 Take into account the deformation.
4756 E_theta=(delthec*sigcsq*term1
4757 & +ak*delthe0*sig0inv*term2)/termexp
4758 E_tc=((sigtc+aktc*sig0i)/termpre
4759 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4760 & aktc*term2)/termexp)
4763 c-----------------------------------------------------------------------------
4764 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4765 implicit real*8 (a-h,o-z)
4766 include 'DIMENSIONS'
4767 include 'COMMON.LOCAL'
4768 include 'COMMON.IOUNITS'
4769 common /calcthet/ term1,term2,termm,diffak,ratak,
4770 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4771 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4772 delthec=thetai-thet_pred_mean
4773 delthe0=thetai-theta0i
4774 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4775 t3 = thetai-thet_pred_mean
4779 t14 = t12+t6*sigsqtc
4781 t21 = thetai-theta0i
4787 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4788 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4789 & *(-t12*t9-ak*sig0inv*t27)
4793 C--------------------------------------------------------------------------
4794 subroutine ebend(etheta)
4796 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4797 C angles gamma and its derivatives in consecutive thetas and gammas.
4798 C ab initio-derived potentials from
4799 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4801 implicit real*8 (a-h,o-z)
4802 include 'DIMENSIONS'
4803 include 'COMMON.LOCAL'
4804 include 'COMMON.GEO'
4805 include 'COMMON.INTERACT'
4806 include 'COMMON.DERIV'
4807 include 'COMMON.VAR'
4808 include 'COMMON.CHAIN'
4809 include 'COMMON.IOUNITS'
4810 include 'COMMON.NAMES'
4811 include 'COMMON.FFIELD'
4812 include 'COMMON.CONTROL'
4813 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4814 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4815 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4816 & sinph1ph2(maxdouble,maxdouble)
4817 logical lprn /.false./, lprn1 /.false./
4819 do i=ithet_start,ithet_end
4823 theti2=0.5d0*theta(i)
4824 ityp2=ithetyp(itype(i-1))
4826 coskt(k)=dcos(k*theti2)
4827 sinkt(k)=dsin(k*theti2)
4832 if (phii.ne.phii) phii=150.0
4836 ityp1=ithetyp(itype(i-2))
4838 cosph1(k)=dcos(k*phii)
4839 sinph1(k)=dsin(k*phii)
4851 if (iabs(itype(i+1)).eq.20) iblock=2
4852 if (iabs(itype(i+1)).ne.20) iblock=1
4855 if (phii1.ne.phii1) phii1=150.0
4860 ityp3=ithetyp(itype(i))
4862 cosph2(k)=dcos(k*phii1)
4863 sinph2(k)=dsin(k*phii1)
4873 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4876 ccl=cosph1(l)*cosph2(k-l)
4877 ssl=sinph1(l)*sinph2(k-l)
4878 scl=sinph1(l)*cosph2(k-l)
4879 csl=cosph1(l)*sinph2(k-l)
4880 cosph1ph2(l,k)=ccl-ssl
4881 cosph1ph2(k,l)=ccl+ssl
4882 sinph1ph2(l,k)=scl+csl
4883 sinph1ph2(k,l)=scl-csl
4887 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4888 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4889 write (iout,*) "coskt and sinkt"
4891 write (iout,*) k,coskt(k),sinkt(k)
4895 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4896 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4899 & write (iout,*) "k",k,
4900 & "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4901 & " ethetai",ethetai
4904 write (iout,*) "cosph and sinph"
4906 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4908 write (iout,*) "cosph1ph2 and sinph2ph2"
4911 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4912 & sinph1ph2(l,k),sinph1ph2(k,l)
4915 write(iout,*) "ethetai",ethetai
4919 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4920 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4921 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4922 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4923 ethetai=ethetai+sinkt(m)*aux
4924 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4925 dephii=dephii+k*sinkt(m)*(
4926 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4927 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4928 dephii1=dephii1+k*sinkt(m)*(
4929 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4930 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4932 & write (iout,*) "m",m," k",k," bbthet",
4933 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4934 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4935 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4936 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4940 & write(iout,*) "ethetai",ethetai
4944 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4945 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4946 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4947 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4949 ethetai=ethetai+sinkt(m)*aux
4950 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4951 dephii=dephii+l*sinkt(m)*(
4952 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4953 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4954 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4955 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4957 dephii1=dephii1+(k-l)*sinkt(m)*(
4958 &-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4959 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4960 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4961 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4964 write (iout,*) "m",m," k",k," l",l," ffthet",
4965 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4966 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4967 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4968 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4969 & " ethetai",ethetai
4971 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4972 & cosph1ph2(k,l)*sinkt(m),
4973 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4980 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4981 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
4982 & phii1*rad2deg,ethetai
4984 etheta=etheta+ethetai
4985 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4986 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4987 gloc(nphi+i-2,icg)=wang*dethetai
4993 c-----------------------------------------------------------------------------
4994 subroutine esc(escloc)
4995 C Calculate the local energy of a side chain and its derivatives in the
4996 C corresponding virtual-bond valence angles THETA and the spherical angles
4998 implicit real*8 (a-h,o-z)
4999 include 'DIMENSIONS'
5000 include 'COMMON.GEO'
5001 include 'COMMON.LOCAL'
5002 include 'COMMON.VAR'
5003 include 'COMMON.INTERACT'
5004 include 'COMMON.DERIV'
5005 include 'COMMON.CHAIN'
5006 include 'COMMON.IOUNITS'
5007 include 'COMMON.NAMES'
5008 include 'COMMON.FFIELD'
5009 include 'COMMON.CONTROL'
5010 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5011 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5012 common /sccalc/ time11,time12,time112,theti,it,nlobit
5015 c write (iout,'(a)') 'ESC'
5016 do i=loc_start,loc_end
5018 if (it.eq.10) goto 1
5020 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5021 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5022 theti=theta(i+1)-pipol
5027 if (x(2).gt.pi-delta) then
5031 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5033 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5034 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5036 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5037 & ddersc0(1),dersc(1))
5038 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5039 & ddersc0(3),dersc(3))
5041 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5043 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5044 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5045 & dersc0(2),esclocbi,dersc02)
5046 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5048 call splinthet(x(2),0.5d0*delta,ss,ssd)
5053 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5055 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5056 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5058 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5060 c write (iout,*) escloci
5061 else if (x(2).lt.delta) then
5065 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5067 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5068 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5070 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5071 & ddersc0(1),dersc(1))
5072 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5073 & ddersc0(3),dersc(3))
5075 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5077 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5078 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5079 & dersc0(2),esclocbi,dersc02)
5080 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5085 call splinthet(x(2),0.5d0*delta,ss,ssd)
5087 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5089 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5090 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5092 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5093 c write (iout,*) escloci
5095 call enesc(x,escloci,dersc,ddummy,.false.)
5098 escloc=escloc+escloci
5099 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5100 & 'escloc',i,escloci
5101 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5103 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5105 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5106 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5111 C---------------------------------------------------------------------------
5112 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5113 implicit real*8 (a-h,o-z)
5114 include 'DIMENSIONS'
5115 include 'COMMON.GEO'
5116 include 'COMMON.LOCAL'
5117 include 'COMMON.IOUNITS'
5118 common /sccalc/ time11,time12,time112,theti,it,nlobit
5119 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5120 double precision contr(maxlob,-1:1)
5122 c write (iout,*) 'it=',it,' nlobit=',nlobit
5126 if (mixed) ddersc(j)=0.0d0
5130 C Because of periodicity of the dependence of the SC energy in omega we have
5131 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5132 C To avoid underflows, first compute & store the exponents.
5140 z(k)=x(k)-censc(k,j,it)
5145 Axk=Axk+gaussc(l,k,j,it)*z(l)
5151 expfac=expfac+Ax(k,j,iii)*z(k)
5159 C As in the case of ebend, we want to avoid underflows in exponentiation and
5160 C subsequent NaNs and INFs in energy calculation.
5161 C Find the largest exponent
5165 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5169 cd print *,'it=',it,' emin=',emin
5171 C Compute the contribution to SC energy and derivatives
5176 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5177 if(adexp.ne.adexp) adexp=1.0
5180 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5182 cd print *,'j=',j,' expfac=',expfac
5183 escloc_i=escloc_i+expfac
5185 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5189 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5190 & +gaussc(k,2,j,it))*expfac
5197 dersc(1)=dersc(1)/cos(theti)**2
5198 ddersc(1)=ddersc(1)/cos(theti)**2
5201 escloci=-(dlog(escloc_i)-emin)
5203 dersc(j)=dersc(j)/escloc_i
5207 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5212 C------------------------------------------------------------------------------
5213 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5214 implicit real*8 (a-h,o-z)
5215 include 'DIMENSIONS'
5216 include 'COMMON.GEO'
5217 include 'COMMON.LOCAL'
5218 include 'COMMON.IOUNITS'
5219 common /sccalc/ time11,time12,time112,theti,it,nlobit
5220 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5221 double precision contr(maxlob)
5232 z(k)=x(k)-censc(k,j,it)
5238 Axk=Axk+gaussc(l,k,j,it)*z(l)
5244 expfac=expfac+Ax(k,j)*z(k)
5249 C As in the case of ebend, we want to avoid underflows in exponentiation and
5250 C subsequent NaNs and INFs in energy calculation.
5251 C Find the largest exponent
5254 if (emin.gt.contr(j)) emin=contr(j)
5258 C Compute the contribution to SC energy and derivatives
5262 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5263 escloc_i=escloc_i+expfac
5265 dersc(k)=dersc(k)+Ax(k,j)*expfac
5267 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5268 & +gaussc(1,2,j,it))*expfac
5272 dersc(1)=dersc(1)/cos(theti)**2
5273 dersc12=dersc12/cos(theti)**2
5274 escloci=-(dlog(escloc_i)-emin)
5276 dersc(j)=dersc(j)/escloc_i
5278 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5282 c----------------------------------------------------------------------------------
5283 subroutine esc(escloc)
5284 C Calculate the local energy of a side chain and its derivatives in the
5285 C corresponding virtual-bond valence angles THETA and the spherical angles
5286 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5287 C added by Urszula Kozlowska. 07/11/2007
5289 implicit real*8 (a-h,o-z)
5290 include 'DIMENSIONS'
5291 include 'COMMON.GEO'
5292 include 'COMMON.LOCAL'
5293 include 'COMMON.VAR'
5294 include 'COMMON.SCROT'
5295 include 'COMMON.INTERACT'
5296 include 'COMMON.DERIV'
5297 include 'COMMON.CHAIN'
5298 include 'COMMON.IOUNITS'
5299 include 'COMMON.NAMES'
5300 include 'COMMON.FFIELD'
5301 include 'COMMON.CONTROL'
5302 include 'COMMON.VECTORS'
5303 double precision x_prime(3),y_prime(3),z_prime(3)
5304 & , sumene,dsc_i,dp2_i,x(65),
5305 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5306 & de_dxx,de_dyy,de_dzz,de_dt
5307 double precision s1_t,s1_6_t,s2_t,s2_6_t
5309 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5310 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5311 & dt_dCi(3),dt_dCi1(3)
5312 common /sccalc/ time11,time12,time112,theti,it,nlobit
5315 do i=loc_start,loc_end
5316 costtab(i+1) =dcos(theta(i+1))
5317 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5318 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5319 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5320 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5321 cosfac=dsqrt(cosfac2)
5322 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5323 sinfac=dsqrt(sinfac2)
5325 if (it.eq.10) goto 1
5327 C Compute the axes of tghe local cartesian coordinates system; store in
5328 c x_prime, y_prime and z_prime
5335 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5336 C & dc_norm(3,i+nres)
5338 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5339 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5342 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5345 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5346 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5347 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5348 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5349 c & " xy",scalar(x_prime(1),y_prime(1)),
5350 c & " xz",scalar(x_prime(1),z_prime(1)),
5351 c & " yy",scalar(y_prime(1),y_prime(1)),
5352 c & " yz",scalar(y_prime(1),z_prime(1)),
5353 c & " zz",scalar(z_prime(1),z_prime(1))
5355 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5356 C to local coordinate system. Store in xx, yy, zz.
5362 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5363 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5364 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5371 C Compute the energy of the ith side cbain
5373 c write (2,*) "xx",xx," yy",yy," zz",zz
5376 x(j) = sc_parmin(j,it)
5379 Cc diagnostics - remove later
5381 yy1 = dsin(alph(2))*dcos(omeg(2))
5382 zz1 = -dsign(1.0, dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5383 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5384 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5386 C," --- ", xx_w,yy_w,zz_w
5389 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5390 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5392 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5393 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5395 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5396 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5397 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5398 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5399 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5401 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5402 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5403 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5404 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5405 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5407 dsc_i = 0.743d0+x(61)
5409 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5410 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5411 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5412 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5413 s1=(1+x(63))/(0.1d0 + dscp1)
5414 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5415 s2=(1+x(65))/(0.1d0 + dscp2)
5416 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5417 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5418 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5419 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5421 c & dscp1,dscp2,sumene
5422 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5423 escloc = escloc + sumene
5424 c write (2,*) "i",i," escloc",sumene,escloc
5427 C This section to check the numerical derivatives of the energy of ith side
5428 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5429 C #define DEBUG in the code to turn it on.
5431 write (2,*) "sumene =",sumene
5435 write (2,*) xx,yy,zz
5436 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5437 de_dxx_num=(sumenep-sumene)/aincr
5439 write (2,*) "xx+ sumene from enesc=",sumenep
5442 write (2,*) xx,yy,zz
5443 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5444 de_dyy_num=(sumenep-sumene)/aincr
5446 write (2,*) "yy+ sumene from enesc=",sumenep
5449 write (2,*) xx,yy,zz
5450 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5451 de_dzz_num=(sumenep-sumene)/aincr
5453 write (2,*) "zz+ sumene from enesc=",sumenep
5454 costsave=cost2tab(i+1)
5455 sintsave=sint2tab(i+1)
5456 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5457 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5458 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5459 de_dt_num=(sumenep-sumene)/aincr
5460 write (2,*) " t+ sumene from enesc=",sumenep
5461 cost2tab(i+1)=costsave
5462 sint2tab(i+1)=sintsave
5463 C End of diagnostics section.
5466 C Compute the gradient of esc
5468 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5469 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5470 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5471 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5472 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5473 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5474 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5475 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5476 pom1=(sumene3*sint2tab(i+1)+sumene1)
5477 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5478 pom2=(sumene4*cost2tab(i+1)+sumene2)
5479 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5480 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5481 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5482 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5484 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5485 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5486 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5488 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5489 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5490 & +(pom1+pom2)*pom_dx
5492 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5495 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5496 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5497 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5499 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5500 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5501 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5502 & +x(59)*zz**2 +x(60)*xx*zz
5503 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5504 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5505 & +(pom1-pom2)*pom_dy
5507 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5510 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5511 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5512 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5513 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5514 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5515 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5516 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5517 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5519 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5522 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5523 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5524 & +pom1*pom_dt1+pom2*pom_dt2
5526 write(2,*), "de_dt = ", de_dt,de_dt_num
5530 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5531 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5532 cosfac2xx=cosfac2*xx
5533 sinfac2yy=sinfac2*yy
5535 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5537 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5539 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5540 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5541 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5542 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5543 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5544 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5545 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5546 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5547 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5548 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5552 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5553 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5554 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5555 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5558 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5559 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5560 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5562 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5563 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5567 dXX_Ctab(k,i)=dXX_Ci(k)
5568 dXX_C1tab(k,i)=dXX_Ci1(k)
5569 dYY_Ctab(k,i)=dYY_Ci(k)
5570 dYY_C1tab(k,i)=dYY_Ci1(k)
5571 dZZ_Ctab(k,i)=dZZ_Ci(k)
5572 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5573 dXX_XYZtab(k,i)=dXX_XYZ(k)
5574 dYY_XYZtab(k,i)=dYY_XYZ(k)
5575 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5579 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5580 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5581 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5582 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5583 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5585 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5586 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5587 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5588 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5589 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5590 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5591 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5592 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5594 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5595 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5597 C to check gradient call subroutine check_grad
5603 c------------------------------------------------------------------------------
5604 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5606 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5607 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5608 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5609 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5611 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5612 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5614 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5615 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5616 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5617 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5618 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5620 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5621 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5622 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5623 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5624 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5626 dsc_i = 0.743d0+x(61)
5628 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5629 & *(xx*cost2+yy*sint2))
5630 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5631 & *(xx*cost2-yy*sint2))
5632 s1=(1+x(63))/(0.1d0 + dscp1)
5633 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5634 s2=(1+x(65))/(0.1d0 + dscp2)
5635 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5636 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5637 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5642 c------------------------------------------------------------------------------
5643 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5645 C This procedure calculates two-body contact function g(rij) and its derivative:
5648 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5651 C where x=(rij-r0ij)/delta
5653 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5656 double precision rij,r0ij,eps0ij,fcont,fprimcont
5657 double precision x,x2,x4,delta
5661 if (x.lt.-1.0D0) then
5664 else if (x.le.1.0D0) then
5667 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5668 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5675 c------------------------------------------------------------------------------
5676 subroutine splinthet(theti,delta,ss,ssder)
5677 implicit real*8 (a-h,o-z)
5678 include 'DIMENSIONS'
5679 include 'COMMON.VAR'
5680 include 'COMMON.GEO'
5683 if (theti.gt.pipol) then
5684 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5686 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5691 c------------------------------------------------------------------------------
5692 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5694 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5695 double precision ksi,ksi2,ksi3,a1,a2,a3
5696 a1=fprim0*delta/(f1-f0)
5702 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5703 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5706 c------------------------------------------------------------------------------
5707 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5709 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5710 double precision ksi,ksi2,ksi3,a1,a2,a3
5715 a2=3*(f1x-f0x)-2*fprim0x*delta
5716 a3=fprim0x*delta-2*(f1x-f0x)
5717 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5720 C-----------------------------------------------------------------------------
5722 C-----------------------------------------------------------------------------
5723 subroutine etor(etors,edihcnstr)
5724 implicit real*8 (a-h,o-z)
5725 include 'DIMENSIONS'
5726 include 'COMMON.VAR'
5727 include 'COMMON.GEO'
5728 include 'COMMON.LOCAL'
5729 include 'COMMON.TORSION'
5730 include 'COMMON.INTERACT'
5731 include 'COMMON.DERIV'
5732 include 'COMMON.CHAIN'
5733 include 'COMMON.NAMES'
5734 include 'COMMON.IOUNITS'
5735 include 'COMMON.FFIELD'
5736 include 'COMMON.TORCNSTR'
5737 include 'COMMON.CONTROL'
5739 C Set lprn=.true. for debugging
5743 do i=iphi_start,iphi_end
5745 itori=itortyp(itype(i-2))
5746 itori1=itortyp(itype(i-1))
5749 C Proline-Proline pair is a special case...
5750 if (itori.eq.3 .and. itori1.eq.3) then
5751 if (phii.gt.-dwapi3) then
5753 fac=1.0D0/(1.0D0-cosphi)
5754 etorsi=v1(1,3,3)*fac
5755 etorsi=etorsi+etorsi
5756 etors=etors+etorsi-v1(1,3,3)
5757 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5758 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5761 v1ij=v1(j+1,itori,itori1)
5762 v2ij=v2(j+1,itori,itori1)
5765 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5766 if (energy_dec) etors_ii=etors_ii+
5767 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5768 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5772 v1ij=v1(j,itori,itori1)
5773 v2ij=v2(j,itori,itori1)
5776 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5777 if (energy_dec) etors_ii=etors_ii+
5778 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5779 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5782 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5785 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5786 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5787 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5788 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5789 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5791 ! 6/20/98 - dihedral angle constraints
5794 itori=idih_constr(i)
5797 if (difi.gt.drange(i)) then
5799 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5800 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5801 else if (difi.lt.-drange(i)) then
5803 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5804 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5806 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5807 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5809 ! write (iout,*) 'edihcnstr',edihcnstr
5812 c------------------------------------------------------------------------------
5813 subroutine etor_d(etors_d)
5817 c----------------------------------------------------------------------------
5819 subroutine etor(etors,edihcnstr)
5820 implicit real*8 (a-h,o-z)
5821 include 'DIMENSIONS'
5822 include 'COMMON.VAR'
5823 include 'COMMON.GEO'
5824 include 'COMMON.LOCAL'
5825 include 'COMMON.TORSION'
5826 include 'COMMON.INTERACT'
5827 include 'COMMON.DERIV'
5828 include 'COMMON.CHAIN'
5829 include 'COMMON.NAMES'
5830 include 'COMMON.IOUNITS'
5831 include 'COMMON.FFIELD'
5832 include 'COMMON.TORCNSTR'
5833 include 'COMMON.CONTROL'
5835 C Set lprn=.true. for debugging
5839 do i=iphi_start,iphi_end
5840 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5841 & .or. itype(i).eq.ntyp1) cycle
5843 if (iabs(itype(i)).eq.20) then
5848 itori=itortyp(itype(i-2))
5849 itori1=itortyp(itype(i-1))
5852 C Regular cosine and sine terms
5853 do j=1,nterm(itori,itori1,iblock)
5854 v1ij=v1(j,itori,itori1,iblock)
5855 v2ij=v2(j,itori,itori1,iblock)
5858 etors=etors+v1ij*cosphi+v2ij*sinphi
5859 if (energy_dec) etors_ii=etors_ii+
5860 & v1ij*cosphi+v2ij*sinphi
5861 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5865 C E = SUM ----------------------------------- - v1
5866 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5868 cosphi=dcos(0.5d0*phii)
5869 sinphi=dsin(0.5d0*phii)
5870 do j=1,nlor(itori,itori1,iblock)
5871 vl1ij=vlor1(j,itori,itori1)
5872 vl2ij=vlor2(j,itori,itori1)
5873 vl3ij=vlor3(j,itori,itori1)
5874 pom=vl2ij*cosphi+vl3ij*sinphi
5875 pom1=1.0d0/(pom*pom+1.0d0)
5876 etors=etors+vl1ij*pom1
5877 if (energy_dec) etors_ii=etors_ii+
5880 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5882 C Subtract the constant term
5883 etors=etors-v0(itori,itori1,iblock)
5884 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5885 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5887 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5888 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5889 & (v1(j,itori,itori1,iblock),j=1,6),
5890 & (v2(j,itori,itori1,iblock),j=1,6)
5891 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5892 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5894 ! 6/20/98 - dihedral angle constraints
5896 c do i=1,ndih_constr
5897 do i=idihconstr_start,idihconstr_end
5898 itori=idih_constr(i)
5900 difi=pinorm(phii-phi0(i))
5901 if (difi.gt.drange(i)) then
5903 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5904 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5905 else if (difi.lt.-drange(i)) then
5907 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5908 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5912 c write (iout,*) "gloci", gloc(i-3,icg)
5913 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5914 cd & rad2deg*phi0(i), rad2deg*drange(i),
5915 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5917 cd write (iout,*) 'edihcnstr',edihcnstr
5920 c----------------------------------------------------------------------------
5921 subroutine etor_d(etors_d)
5922 C 6/23/01 Compute double torsional energy
5923 implicit real*8 (a-h,o-z)
5924 include 'DIMENSIONS'
5925 include 'COMMON.VAR'
5926 include 'COMMON.GEO'
5927 include 'COMMON.LOCAL'
5928 include 'COMMON.TORSION'
5929 include 'COMMON.INTERACT'
5930 include 'COMMON.DERIV'
5931 include 'COMMON.CHAIN'
5932 include 'COMMON.NAMES'
5933 include 'COMMON.IOUNITS'
5934 include 'COMMON.FFIELD'
5935 include 'COMMON.TORCNSTR'
5937 C Set lprn=.true. for debugging
5941 c write(iout,*) "a tu??"
5942 do i=iphid_start,iphid_end
5943 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5944 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5945 itori=itortyp(itype(i-2))
5946 itori1=itortyp(itype(i-1))
5947 itori2=itortyp(itype(i))
5953 if (iabs(itype(i+1)).eq.20) iblock=2
5955 C Regular cosine and sine terms
5956 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5957 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5958 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5959 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5960 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5961 cosphi1=dcos(j*phii)
5962 sinphi1=dsin(j*phii)
5963 cosphi2=dcos(j*phii1)
5964 sinphi2=dsin(j*phii1)
5965 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5966 & v2cij*cosphi2+v2sij*sinphi2
5967 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5968 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5970 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5972 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5973 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5974 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5975 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5976 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5977 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5978 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5979 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5980 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5981 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5982 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5983 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5984 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5985 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5988 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5989 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5994 c------------------------------------------------------------------------------
5995 subroutine eback_sc_corr(esccor)
5996 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5997 c conformational states; temporarily implemented as differences
5998 c between UNRES torsional potentials (dependent on three types of
5999 c residues) and the torsional potentials dependent on all 20 types
6000 c of residues computed from AM1 energy surfaces of terminally-blocked
6001 c amino-acid residues.
6002 implicit real*8 (a-h,o-z)
6003 include 'DIMENSIONS'
6004 include 'COMMON.VAR'
6005 include 'COMMON.GEO'
6006 include 'COMMON.LOCAL'
6007 include 'COMMON.TORSION'
6008 include 'COMMON.SCCOR'
6009 include 'COMMON.INTERACT'
6010 include 'COMMON.DERIV'
6011 include 'COMMON.CHAIN'
6012 include 'COMMON.NAMES'
6013 include 'COMMON.IOUNITS'
6014 include 'COMMON.FFIELD'
6015 include 'COMMON.CONTROL'
6017 C Set lprn=.true. for debugging
6020 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6022 do i=itau_start,itau_end
6024 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6025 isccori=isccortyp(itype(i-2))
6026 isccori1=isccortyp(itype(i-1))
6028 cccc Added 9 May 2012
6029 cc Tauangle is torsional engle depending on the value of first digit
6030 c(see comment below)
6031 cc Omicron is flat angle depending on the value of first digit
6032 c(see comment below)
6035 do intertyp=1,3 !intertyp
6036 cc Added 09 May 2012 (Adasko)
6037 cc Intertyp means interaction type of backbone mainchain correlation:
6038 c 1 = SC...Ca...Ca...Ca
6039 c 2 = Ca...Ca...Ca...SC
6040 c 3 = SC...Ca...Ca...SCi
6042 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6043 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6044 & (itype(i-1).eq.ntyp1)))
6045 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6046 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6047 & .or.(itype(i).eq.ntyp1)))
6048 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6049 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6050 & (itype(i-3).eq.ntyp1)))) cycle
6051 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6052 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6054 do j=1,nterm_sccor(isccori,isccori1)
6055 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6056 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6057 cosphi=dcos(j*tauangle(intertyp,i))
6058 sinphi=dsin(j*tauangle(intertyp,i))
6059 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6060 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6062 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6063 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6064 c &gloc_sc(intertyp,i-3,icg)
6066 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6067 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6068 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6069 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6070 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6074 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6078 c----------------------------------------------------------------------------
6079 subroutine multibody(ecorr)
6080 C This subroutine calculates multi-body contributions to energy following
6081 C the idea of Skolnick et al. If side chains I and J make a contact and
6082 C at the same time side chains I+1 and J+1 make a contact, an extra
6083 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6084 implicit real*8 (a-h,o-z)
6085 include 'DIMENSIONS'
6086 include 'COMMON.IOUNITS'
6087 include 'COMMON.DERIV'
6088 include 'COMMON.INTERACT'
6089 include 'COMMON.CONTACTS'
6090 double precision gx(3),gx1(3)
6093 C Set lprn=.true. for debugging
6097 write (iout,'(a)') 'Contact function values:'
6099 write (iout,'(i2,20(1x,i2,f10.5))')
6100 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6115 num_conti=num_cont(i)
6116 num_conti1=num_cont(i1)
6121 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6122 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6123 cd & ' ishift=',ishift
6124 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6125 C The system gains extra energy.
6126 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6127 endif ! j1==j+-ishift
6136 c------------------------------------------------------------------------------
6137 double precision function esccorr(i,j,k,l,jj,kk)
6138 implicit real*8 (a-h,o-z)
6139 include 'DIMENSIONS'
6140 include 'COMMON.IOUNITS'
6141 include 'COMMON.DERIV'
6142 include 'COMMON.INTERACT'
6143 include 'COMMON.CONTACTS'
6144 double precision gx(3),gx1(3)
6149 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6150 C Calculate the multi-body contribution to energy.
6151 C Calculate multi-body contributions to the gradient.
6152 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6153 cd & k,l,(gacont(m,kk,k),m=1,3)
6155 gx(m) =ekl*gacont(m,jj,i)
6156 gx1(m)=eij*gacont(m,kk,k)
6157 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6158 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6159 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6160 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6164 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6169 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6175 c------------------------------------------------------------------------------
6176 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6177 C This subroutine calculates multi-body contributions to hydrogen-bonding
6178 implicit real*8 (a-h,o-z)
6179 include 'DIMENSIONS'
6180 include 'COMMON.IOUNITS'
6183 parameter (max_cont=maxconts)
6184 parameter (max_dim=26)
6185 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6186 double precision zapas(max_dim,maxconts,max_fg_procs),
6187 & zapas_recv(max_dim,maxconts,max_fg_procs)
6188 common /przechowalnia/ zapas
6189 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6190 & status_array(MPI_STATUS_SIZE,maxconts*2)
6192 include 'COMMON.SETUP'
6193 include 'COMMON.FFIELD'
6194 include 'COMMON.DERIV'
6195 include 'COMMON.INTERACT'
6196 include 'COMMON.CONTACTS'
6197 include 'COMMON.CONTROL'
6198 include 'COMMON.LOCAL'
6199 double precision gx(3),gx1(3),time00
6202 C Set lprn=.true. for debugging
6207 if (nfgtasks.le.1) goto 30
6209 write (iout,'(a)') 'Contact function values before RECEIVE:'
6211 write (iout,'(2i3,50(1x,i2,f5.2))')
6212 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6213 & j=1,num_cont_hb(i))
6217 do i=1,ntask_cont_from
6220 do i=1,ntask_cont_to
6223 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6225 C Make the list of contacts to send to send to other procesors
6226 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6228 do i=iturn3_start,iturn3_end
6229 c write (iout,*) "make contact list turn3",i," num_cont",
6231 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6233 do i=iturn4_start,iturn4_end
6234 c write (iout,*) "make contact list turn4",i," num_cont",
6236 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6240 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6242 do j=1,num_cont_hb(i)
6245 iproc=iint_sent_local(k,jjc,ii)
6246 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6247 if (iproc.gt.0) then
6248 ncont_sent(iproc)=ncont_sent(iproc)+1
6249 nn=ncont_sent(iproc)
6251 zapas(2,nn,iproc)=jjc
6252 zapas(3,nn,iproc)=facont_hb(j,i)
6253 zapas(4,nn,iproc)=ees0p(j,i)
6254 zapas(5,nn,iproc)=ees0m(j,i)
6255 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6256 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6257 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6258 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6259 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6260 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6261 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6262 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6263 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6264 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6265 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6266 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6267 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6268 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6269 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6270 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6271 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6272 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6273 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6274 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6275 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6282 & "Numbers of contacts to be sent to other processors",
6283 & (ncont_sent(i),i=1,ntask_cont_to)
6284 write (iout,*) "Contacts sent"
6285 do ii=1,ntask_cont_to
6287 iproc=itask_cont_to(ii)
6288 write (iout,*) nn," contacts to processor",iproc,
6289 & " of CONT_TO_COMM group"
6291 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6299 CorrelID1=nfgtasks+fg_rank+1
6301 C Receive the numbers of needed contacts from other processors
6302 do ii=1,ntask_cont_from
6303 iproc=itask_cont_from(ii)
6305 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6306 & FG_COMM,req(ireq),IERR)
6308 c write (iout,*) "IRECV ended"
6310 C Send the number of contacts needed by other processors
6311 do ii=1,ntask_cont_to
6312 iproc=itask_cont_to(ii)
6314 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6315 & FG_COMM,req(ireq),IERR)
6317 c write (iout,*) "ISEND ended"
6318 c write (iout,*) "number of requests (nn)",ireq
6321 & call MPI_Waitall(ireq,req,status_array,ierr)
6323 c & "Numbers of contacts to be received from other processors",
6324 c & (ncont_recv(i),i=1,ntask_cont_from)
6328 do ii=1,ntask_cont_from
6329 iproc=itask_cont_from(ii)
6331 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6332 c & " of CONT_TO_COMM group"
6336 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6337 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6338 c write (iout,*) "ireq,req",ireq,req(ireq)
6341 C Send the contacts to processors that need them
6342 do ii=1,ntask_cont_to
6343 iproc=itask_cont_to(ii)
6345 c write (iout,*) nn," contacts to processor",iproc,
6346 c & " of CONT_TO_COMM group"
6349 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6350 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6351 c write (iout,*) "ireq,req",ireq,req(ireq)
6353 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6357 c write (iout,*) "number of requests (contacts)",ireq
6358 c write (iout,*) "req",(req(i),i=1,4)
6361 & call MPI_Waitall(ireq,req,status_array,ierr)
6362 do iii=1,ntask_cont_from
6363 iproc=itask_cont_from(iii)
6366 write (iout,*) "Received",nn," contacts from processor",iproc,
6367 & " of CONT_FROM_COMM group"
6370 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6375 ii=zapas_recv(1,i,iii)
6376 c Flag the received contacts to prevent double-counting
6377 jj=-zapas_recv(2,i,iii)
6378 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6380 nnn=num_cont_hb(ii)+1
6383 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6384 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6385 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6386 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6387 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6388 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6389 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6390 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6391 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6392 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6393 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6394 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6395 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6396 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6397 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6398 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6399 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6400 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6401 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6402 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6403 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6404 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6405 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6406 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6411 write (iout,'(a)') 'Contact function values after receive:'
6413 write (iout,'(2i3,50(1x,i3,f5.2))')
6414 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6415 & j=1,num_cont_hb(i))
6422 write (iout,'(a)') 'Contact function values:'
6424 write (iout,'(2i3,50(1x,i3,f5.2))')
6425 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6426 & j=1,num_cont_hb(i))
6430 C Remove the loop below after debugging !!!
6437 C Calculate the local-electrostatic correlation terms
6438 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6440 num_conti=num_cont_hb(i)
6441 num_conti1=num_cont_hb(i+1)
6448 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6449 c & ' jj=',jj,' kk=',kk
6450 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6451 & .or. j.lt.0 .and. j1.gt.0) .and.
6452 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6453 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6454 C The system gains extra energy.
6455 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6456 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6457 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6459 else if (j1.eq.j) then
6460 C Contacts I-J and I-(J+1) occur simultaneously.
6461 C The system loses extra energy.
6462 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6467 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6468 c & ' jj=',jj,' kk=',kk
6470 C Contacts I-J and (I+1)-J occur simultaneously.
6471 C The system loses extra energy.
6472 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6479 c------------------------------------------------------------------------------
6480 subroutine add_hb_contact(ii,jj,itask)
6481 implicit real*8 (a-h,o-z)
6482 include "DIMENSIONS"
6483 include "COMMON.IOUNITS"
6486 parameter (max_cont=maxconts)
6487 parameter (max_dim=26)
6488 include "COMMON.CONTACTS"
6489 double precision zapas(max_dim,maxconts,max_fg_procs),
6490 & zapas_recv(max_dim,maxconts,max_fg_procs)
6491 common /przechowalnia/ zapas
6492 integer i,j,ii,jj,iproc,itask(4),nn
6493 c write (iout,*) "itask",itask
6496 if (iproc.gt.0) then
6497 do j=1,num_cont_hb(ii)
6499 c write (iout,*) "i",ii," j",jj," jjc",jjc
6501 ncont_sent(iproc)=ncont_sent(iproc)+1
6502 nn=ncont_sent(iproc)
6503 zapas(1,nn,iproc)=ii
6504 zapas(2,nn,iproc)=jjc
6505 zapas(3,nn,iproc)=facont_hb(j,ii)
6506 zapas(4,nn,iproc)=ees0p(j,ii)
6507 zapas(5,nn,iproc)=ees0m(j,ii)
6508 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6509 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6510 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6511 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6512 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6513 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6514 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6515 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6516 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6517 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6518 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6519 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6520 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6521 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6522 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6523 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6524 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6525 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6526 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6527 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6528 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6536 c------------------------------------------------------------------------------
6537 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6539 C This subroutine calculates multi-body contributions to hydrogen-bonding
6540 implicit real*8 (a-h,o-z)
6541 include 'DIMENSIONS'
6542 include 'COMMON.IOUNITS'
6545 parameter (max_cont=maxconts)
6546 parameter (max_dim=70)
6547 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6548 double precision zapas(max_dim,maxconts,max_fg_procs),
6549 & zapas_recv(max_dim,maxconts,max_fg_procs)
6550 common /przechowalnia/ zapas
6551 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6552 & status_array(MPI_STATUS_SIZE,maxconts*2)
6554 include 'COMMON.SETUP'
6555 include 'COMMON.FFIELD'
6556 include 'COMMON.DERIV'
6557 include 'COMMON.LOCAL'
6558 include 'COMMON.INTERACT'
6559 include 'COMMON.CONTACTS'
6560 include 'COMMON.CHAIN'
6561 include 'COMMON.CONTROL'
6562 double precision gx(3),gx1(3)
6563 integer num_cont_hb_old(maxres)
6565 double precision eello4,eello5,eelo6,eello_turn6
6566 external eello4,eello5,eello6,eello_turn6
6567 C Set lprn=.true. for debugging
6572 num_cont_hb_old(i)=num_cont_hb(i)
6576 if (nfgtasks.le.1) goto 30
6578 write (iout,'(a)') 'Contact function values before RECEIVE:'
6580 write (iout,'(2i3,50(1x,i2,f5.2))')
6581 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6582 & j=1,num_cont_hb(i))
6586 do i=1,ntask_cont_from
6589 do i=1,ntask_cont_to
6592 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6594 C Make the list of contacts to send to send to other procesors
6595 do i=iturn3_start,iturn3_end
6596 c write (iout,*) "make contact list turn3",i," num_cont",
6598 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6600 do i=iturn4_start,iturn4_end
6601 c write (iout,*) "make contact list turn4",i," num_cont",
6603 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6607 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6609 do j=1,num_cont_hb(i)
6612 iproc=iint_sent_local(k,jjc,ii)
6613 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6614 if (iproc.ne.0) then
6615 ncont_sent(iproc)=ncont_sent(iproc)+1
6616 nn=ncont_sent(iproc)
6618 zapas(2,nn,iproc)=jjc
6619 zapas(3,nn,iproc)=d_cont(j,i)
6623 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6628 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6636 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6647 & "Numbers of contacts to be sent to other processors",
6648 & (ncont_sent(i),i=1,ntask_cont_to)
6649 write (iout,*) "Contacts sent"
6650 do ii=1,ntask_cont_to
6652 iproc=itask_cont_to(ii)
6653 write (iout,*) nn," contacts to processor",iproc,
6654 & " of CONT_TO_COMM group"
6656 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6664 CorrelID1=nfgtasks+fg_rank+1
6666 C Receive the numbers of needed contacts from other processors
6667 do ii=1,ntask_cont_from
6668 iproc=itask_cont_from(ii)
6670 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6671 & FG_COMM,req(ireq),IERR)
6673 c write (iout,*) "IRECV ended"
6675 C Send the number of contacts needed by other processors
6676 do ii=1,ntask_cont_to
6677 iproc=itask_cont_to(ii)
6679 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6680 & FG_COMM,req(ireq),IERR)
6682 c write (iout,*) "ISEND ended"
6683 c write (iout,*) "number of requests (nn)",ireq
6686 & call MPI_Waitall(ireq,req,status_array,ierr)
6688 c & "Numbers of contacts to be received from other processors",
6689 c & (ncont_recv(i),i=1,ntask_cont_from)
6693 do ii=1,ntask_cont_from
6694 iproc=itask_cont_from(ii)
6696 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6697 c & " of CONT_TO_COMM group"
6701 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6702 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6703 c write (iout,*) "ireq,req",ireq,req(ireq)
6706 C Send the contacts to processors that need them
6707 do ii=1,ntask_cont_to
6708 iproc=itask_cont_to(ii)
6710 c write (iout,*) nn," contacts to processor",iproc,
6711 c & " of CONT_TO_COMM group"
6714 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6715 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6716 c write (iout,*) "ireq,req",ireq,req(ireq)
6718 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6722 c write (iout,*) "number of requests (contacts)",ireq
6723 c write (iout,*) "req",(req(i),i=1,4)
6726 & call MPI_Waitall(ireq,req,status_array,ierr)
6727 do iii=1,ntask_cont_from
6728 iproc=itask_cont_from(iii)
6731 write (iout,*) "Received",nn," contacts from processor",iproc,
6732 & " of CONT_FROM_COMM group"
6735 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6740 ii=zapas_recv(1,i,iii)
6741 c Flag the received contacts to prevent double-counting
6742 jj=-zapas_recv(2,i,iii)
6743 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6745 nnn=num_cont_hb(ii)+1
6748 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6752 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6757 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6765 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6774 write (iout,'(a)') 'Contact function values after receive:'
6776 write (iout,'(2i3,50(1x,i3,5f6.3))')
6777 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6778 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6785 write (iout,'(a)') 'Contact function values:'
6787 write (iout,'(2i3,50(1x,i2,5f6.3))')
6788 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6789 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6795 C Remove the loop below after debugging !!!
6802 C Calculate the dipole-dipole interaction energies
6803 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6804 do i=iatel_s,iatel_e+1
6805 num_conti=num_cont_hb(i)
6814 C Calculate the local-electrostatic correlation terms
6815 c write (iout,*) "gradcorr5 in eello5 before loop"
6817 c write (iout,'(i5,3f10.5)')
6818 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6820 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6821 c write (iout,*) "corr loop i",i
6823 num_conti=num_cont_hb(i)
6824 num_conti1=num_cont_hb(i+1)
6831 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6832 c & ' jj=',jj,' kk=',kk
6833 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6834 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6835 & .or. j.lt.0 .and. j1.gt.0) .and.
6836 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6837 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6838 C The system gains extra energy.
6840 sqd1=dsqrt(d_cont(jj,i))
6841 sqd2=dsqrt(d_cont(kk,i1))
6842 sred_geom = sqd1*sqd2
6843 IF (sred_geom.lt.cutoff_corr) THEN
6844 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6846 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6847 cd & ' jj=',jj,' kk=',kk
6848 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6849 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6851 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6852 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6855 cd write (iout,*) 'sred_geom=',sred_geom,
6856 cd & ' ekont=',ekont,' fprim=',fprimcont,
6857 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6858 cd write (iout,*) "g_contij",g_contij
6859 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6860 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6861 call calc_eello(i,jp,i+1,jp1,jj,kk)
6862 if (wcorr4.gt.0.0d0)
6863 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6864 if (energy_dec.and.wcorr4.gt.0.0d0)
6865 1 write (iout,'(a6,4i5,0pf7.3)')
6866 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6867 c write (iout,*) "gradcorr5 before eello5"
6869 c write (iout,'(i5,3f10.5)')
6870 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6872 if (wcorr5.gt.0.0d0)
6873 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6874 c write (iout,*) "gradcorr5 after eello5"
6876 c write (iout,'(i5,3f10.5)')
6877 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6879 if (energy_dec.and.wcorr5.gt.0.0d0)
6880 1 write (iout,'(a6,4i5,0pf7.3)')
6881 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6882 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6883 cd write(2,*)'ijkl',i,jp,i+1,jp1
6884 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6885 & .or. wturn6.eq.0.0d0))then
6886 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6887 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6888 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6889 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6890 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6891 cd & 'ecorr6=',ecorr6
6892 cd write (iout,'(4e15.5)') sred_geom,
6893 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6894 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6895 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6896 else if (wturn6.gt.0.0d0
6897 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6898 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6899 eturn6=eturn6+eello_turn6(i,jj,kk)
6900 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6901 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6902 cd write (2,*) 'multibody_eello:eturn6',eturn6
6911 num_cont_hb(i)=num_cont_hb_old(i)
6913 c write (iout,*) "gradcorr5 in eello5"
6915 c write (iout,'(i5,3f10.5)')
6916 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6920 c------------------------------------------------------------------------------
6921 subroutine add_hb_contact_eello(ii,jj,itask)
6922 implicit real*8 (a-h,o-z)
6923 include "DIMENSIONS"
6924 include "COMMON.IOUNITS"
6927 parameter (max_cont=maxconts)
6928 parameter (max_dim=70)
6929 include "COMMON.CONTACTS"
6930 double precision zapas(max_dim,maxconts,max_fg_procs),
6931 & zapas_recv(max_dim,maxconts,max_fg_procs)
6932 common /przechowalnia/ zapas
6933 integer i,j,ii,jj,iproc,itask(4),nn
6934 c write (iout,*) "itask",itask
6937 if (iproc.gt.0) then
6938 do j=1,num_cont_hb(ii)
6940 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6942 ncont_sent(iproc)=ncont_sent(iproc)+1
6943 nn=ncont_sent(iproc)
6944 zapas(1,nn,iproc)=ii
6945 zapas(2,nn,iproc)=jjc
6946 zapas(3,nn,iproc)=d_cont(j,ii)
6950 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6955 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6963 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6975 c------------------------------------------------------------------------------
6976 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6977 implicit real*8 (a-h,o-z)
6978 include 'DIMENSIONS'
6979 include 'COMMON.IOUNITS'
6980 include 'COMMON.DERIV'
6981 include 'COMMON.INTERACT'
6982 include 'COMMON.CONTACTS'
6983 double precision gx(3),gx1(3)
6993 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6994 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6995 C Following 4 lines for diagnostics.
7000 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7001 c & 'Contacts ',i,j,
7002 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7003 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7005 C Calculate the multi-body contribution to energy.
7006 c ecorr=ecorr+ekont*ees
7007 C Calculate multi-body contributions to the gradient.
7008 coeffpees0pij=coeffp*ees0pij
7009 coeffmees0mij=coeffm*ees0mij
7010 coeffpees0pkl=coeffp*ees0pkl
7011 coeffmees0mkl=coeffm*ees0mkl
7013 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7014 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7015 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7016 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7017 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7018 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7019 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7020 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7021 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7022 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7023 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7024 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7025 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7026 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7027 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7028 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7029 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7030 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7031 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7032 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7033 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7034 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7035 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7036 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7037 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7042 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7043 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7044 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7045 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7050 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7051 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7052 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7053 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7056 c write (iout,*) "ehbcorr",ekont*ees
7061 C---------------------------------------------------------------------------
7062 subroutine dipole(i,j,jj)
7063 implicit real*8 (a-h,o-z)
7064 include 'DIMENSIONS'
7065 include 'COMMON.IOUNITS'
7066 include 'COMMON.CHAIN'
7067 include 'COMMON.FFIELD'
7068 include 'COMMON.DERIV'
7069 include 'COMMON.INTERACT'
7070 include 'COMMON.CONTACTS'
7071 include 'COMMON.TORSION'
7072 include 'COMMON.VAR'
7073 include 'COMMON.GEO'
7074 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7076 iti1 = itortyp(itype(i+1))
7077 if (j.lt.nres-1) then
7078 itj1 = itortyp(itype(j+1))
7083 dipi(iii,1)=Ub2(iii,i)
7084 dipderi(iii)=Ub2der(iii,i)
7085 dipi(iii,2)=b1(iii,iti1)
7086 dipj(iii,1)=Ub2(iii,j)
7087 dipderj(iii)=Ub2der(iii,j)
7088 dipj(iii,2)=b1(iii,itj1)
7092 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7095 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7102 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7106 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7111 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7112 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7114 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7116 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7118 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7123 C---------------------------------------------------------------------------
7124 subroutine calc_eello(i,j,k,l,jj,kk)
7126 C This subroutine computes matrices and vectors needed to calculate
7127 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7129 implicit real*8 (a-h,o-z)
7130 include 'DIMENSIONS'
7131 include 'COMMON.IOUNITS'
7132 include 'COMMON.CHAIN'
7133 include 'COMMON.DERIV'
7134 include 'COMMON.INTERACT'
7135 include 'COMMON.CONTACTS'
7136 include 'COMMON.TORSION'
7137 include 'COMMON.VAR'
7138 include 'COMMON.GEO'
7139 include 'COMMON.FFIELD'
7140 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7141 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7144 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7145 cd & ' jj=',jj,' kk=',kk
7146 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7147 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7148 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7151 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7152 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7155 call transpose2(aa1(1,1),aa1t(1,1))
7156 call transpose2(aa2(1,1),aa2t(1,1))
7159 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7160 & aa1tder(1,1,lll,kkk))
7161 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7162 & aa2tder(1,1,lll,kkk))
7166 C parallel orientation of the two CA-CA-CA frames.
7168 iti=itortyp(itype(i))
7172 itk1=itortyp(itype(k+1))
7173 itj=itortyp(itype(j))
7174 if (l.lt.nres-1) then
7175 itl1=itortyp(itype(l+1))
7179 C A1 kernel(j+1) A2T
7181 cd write (iout,'(3f10.5,5x,3f10.5)')
7182 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7184 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7185 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7186 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7187 C Following matrices are needed only for 6-th order cumulants
7188 IF (wcorr6.gt.0.0d0) THEN
7189 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7190 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7191 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7192 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7193 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7194 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7195 & ADtEAderx(1,1,1,1,1,1))
7197 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7198 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7199 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7200 & ADtEA1derx(1,1,1,1,1,1))
7202 C End 6-th order cumulants
7205 cd write (2,*) 'In calc_eello6'
7207 cd write (2,*) 'iii=',iii
7209 cd write (2,*) 'kkk=',kkk
7211 cd write (2,'(3(2f10.5),5x)')
7212 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7217 call transpose2(EUgder(1,1,k),auxmat(1,1))
7218 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7219 call transpose2(EUg(1,1,k),auxmat(1,1))
7220 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7221 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7225 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7226 & EAEAderx(1,1,lll,kkk,iii,1))
7230 C A1T kernel(i+1) A2
7231 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7232 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7233 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7234 C Following matrices are needed only for 6-th order cumulants
7235 IF (wcorr6.gt.0.0d0) THEN
7236 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7237 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7238 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7239 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7240 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7241 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7242 & ADtEAderx(1,1,1,1,1,2))
7243 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7244 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7245 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7246 & ADtEA1derx(1,1,1,1,1,2))
7248 C End 6-th order cumulants
7249 call transpose2(EUgder(1,1,l),auxmat(1,1))
7250 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7251 call transpose2(EUg(1,1,l),auxmat(1,1))
7252 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7253 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7257 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7258 & EAEAderx(1,1,lll,kkk,iii,2))
7263 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7264 C They are needed only when the fifth- or the sixth-order cumulants are
7266 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7267 call transpose2(AEA(1,1,1),auxmat(1,1))
7268 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7269 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7270 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7271 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7272 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7273 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7274 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7275 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7276 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7277 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7278 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7279 call transpose2(AEA(1,1,2),auxmat(1,1))
7280 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7281 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7282 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7283 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7284 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7285 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7286 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7287 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7288 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7289 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7290 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7291 C Calculate the Cartesian derivatives of the vectors.
7295 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7296 call matvec2(auxmat(1,1),b1(1,iti),
7297 & AEAb1derx(1,lll,kkk,iii,1,1))
7298 call matvec2(auxmat(1,1),Ub2(1,i),
7299 & AEAb2derx(1,lll,kkk,iii,1,1))
7300 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7301 & AEAb1derx(1,lll,kkk,iii,2,1))
7302 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7303 & AEAb2derx(1,lll,kkk,iii,2,1))
7304 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7305 call matvec2(auxmat(1,1),b1(1,itj),
7306 & AEAb1derx(1,lll,kkk,iii,1,2))
7307 call matvec2(auxmat(1,1),Ub2(1,j),
7308 & AEAb2derx(1,lll,kkk,iii,1,2))
7309 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7310 & AEAb1derx(1,lll,kkk,iii,2,2))
7311 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7312 & AEAb2derx(1,lll,kkk,iii,2,2))
7319 C Antiparallel orientation of the two CA-CA-CA frames.
7321 iti=itortyp(itype(i))
7325 itk1=itortyp(itype(k+1))
7326 itl=itortyp(itype(l))
7327 itj=itortyp(itype(j))
7328 if (j.lt.nres-1) then
7329 itj1=itortyp(itype(j+1))
7333 C A2 kernel(j-1)T A1T
7334 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7335 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7336 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7337 C Following matrices are needed only for 6-th order cumulants
7338 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7339 & j.eq.i+4 .and. l.eq.i+3)) THEN
7340 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7341 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7342 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7343 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7344 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7345 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7346 & ADtEAderx(1,1,1,1,1,1))
7347 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7348 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7349 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7350 & ADtEA1derx(1,1,1,1,1,1))
7352 C End 6-th order cumulants
7353 call transpose2(EUgder(1,1,k),auxmat(1,1))
7354 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7355 call transpose2(EUg(1,1,k),auxmat(1,1))
7356 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7357 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7361 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7362 & EAEAderx(1,1,lll,kkk,iii,1))
7366 C A2T kernel(i+1)T A1
7367 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7368 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7369 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7370 C Following matrices are needed only for 6-th order cumulants
7371 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7372 & j.eq.i+4 .and. l.eq.i+3)) THEN
7373 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7374 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7375 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7376 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7377 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7378 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7379 & ADtEAderx(1,1,1,1,1,2))
7380 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7381 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7382 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7383 & ADtEA1derx(1,1,1,1,1,2))
7385 C End 6-th order cumulants
7386 call transpose2(EUgder(1,1,j),auxmat(1,1))
7387 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7388 call transpose2(EUg(1,1,j),auxmat(1,1))
7389 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7390 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7394 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7395 & EAEAderx(1,1,lll,kkk,iii,2))
7400 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7401 C They are needed only when the fifth- or the sixth-order cumulants are
7403 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7404 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7405 call transpose2(AEA(1,1,1),auxmat(1,1))
7406 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7407 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7408 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7409 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7410 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7411 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7412 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7413 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7414 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7415 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7416 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7417 call transpose2(AEA(1,1,2),auxmat(1,1))
7418 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7419 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7420 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7421 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7422 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7423 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7424 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7425 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7426 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7427 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7428 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7429 C Calculate the Cartesian derivatives of the vectors.
7433 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7434 call matvec2(auxmat(1,1),b1(1,iti),
7435 & AEAb1derx(1,lll,kkk,iii,1,1))
7436 call matvec2(auxmat(1,1),Ub2(1,i),
7437 & AEAb2derx(1,lll,kkk,iii,1,1))
7438 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7439 & AEAb1derx(1,lll,kkk,iii,2,1))
7440 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7441 & AEAb2derx(1,lll,kkk,iii,2,1))
7442 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7443 call matvec2(auxmat(1,1),b1(1,itl),
7444 & AEAb1derx(1,lll,kkk,iii,1,2))
7445 call matvec2(auxmat(1,1),Ub2(1,l),
7446 & AEAb2derx(1,lll,kkk,iii,1,2))
7447 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7448 & AEAb1derx(1,lll,kkk,iii,2,2))
7449 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7450 & AEAb2derx(1,lll,kkk,iii,2,2))
7459 C---------------------------------------------------------------------------
7460 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7461 & KK,KKderg,AKA,AKAderg,AKAderx)
7465 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7466 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7467 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7472 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7474 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7477 cd if (lprn) write (2,*) 'In kernel'
7479 cd if (lprn) write (2,*) 'kkk=',kkk
7481 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7482 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7484 cd write (2,*) 'lll=',lll
7485 cd write (2,*) 'iii=1'
7487 cd write (2,'(3(2f10.5),5x)')
7488 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7491 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7492 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7494 cd write (2,*) 'lll=',lll
7495 cd write (2,*) 'iii=2'
7497 cd write (2,'(3(2f10.5),5x)')
7498 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7505 C---------------------------------------------------------------------------
7506 double precision function eello4(i,j,k,l,jj,kk)
7507 implicit real*8 (a-h,o-z)
7508 include 'DIMENSIONS'
7509 include 'COMMON.IOUNITS'
7510 include 'COMMON.CHAIN'
7511 include 'COMMON.DERIV'
7512 include 'COMMON.INTERACT'
7513 include 'COMMON.CONTACTS'
7514 include 'COMMON.TORSION'
7515 include 'COMMON.VAR'
7516 include 'COMMON.GEO'
7517 double precision pizda(2,2),ggg1(3),ggg2(3)
7518 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7522 cd print *,'eello4:',i,j,k,l,jj,kk
7523 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7524 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7525 cold eij=facont_hb(jj,i)
7526 cold ekl=facont_hb(kk,k)
7528 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7529 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7530 gcorr_loc(k-1)=gcorr_loc(k-1)
7531 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7533 gcorr_loc(l-1)=gcorr_loc(l-1)
7534 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7536 gcorr_loc(j-1)=gcorr_loc(j-1)
7537 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7542 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7543 & -EAEAderx(2,2,lll,kkk,iii,1)
7544 cd derx(lll,kkk,iii)=0.0d0
7548 cd gcorr_loc(l-1)=0.0d0
7549 cd gcorr_loc(j-1)=0.0d0
7550 cd gcorr_loc(k-1)=0.0d0
7552 cd write (iout,*)'Contacts have occurred for peptide groups',
7553 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7554 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7555 if (j.lt.nres-1) then
7562 if (l.lt.nres-1) then
7570 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7571 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7572 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7573 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7574 cgrad ghalf=0.5d0*ggg1(ll)
7575 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7576 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7577 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7578 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7579 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7580 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7581 cgrad ghalf=0.5d0*ggg2(ll)
7582 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7583 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7584 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7585 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7586 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7587 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7591 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7596 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7601 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7606 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7610 cd write (2,*) iii,gcorr_loc(iii)
7613 cd write (2,*) 'ekont',ekont
7614 cd write (iout,*) 'eello4',ekont*eel4
7617 C---------------------------------------------------------------------------
7618 double precision function eello5(i,j,k,l,jj,kk)
7619 implicit real*8 (a-h,o-z)
7620 include 'DIMENSIONS'
7621 include 'COMMON.IOUNITS'
7622 include 'COMMON.CHAIN'
7623 include 'COMMON.DERIV'
7624 include 'COMMON.INTERACT'
7625 include 'COMMON.CONTACTS'
7626 include 'COMMON.TORSION'
7627 include 'COMMON.VAR'
7628 include 'COMMON.GEO'
7629 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7630 double precision ggg1(3),ggg2(3)
7631 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7636 C /l\ / \ \ / \ / \ / C
7637 C / \ / \ \ / \ / \ / C
7638 C j| o |l1 | o | o| o | | o |o C
7639 C \ |/k\| |/ \| / |/ \| |/ \| C
7640 C \i/ \ / \ / / \ / \ C
7642 C (I) (II) (III) (IV) C
7644 C eello5_1 eello5_2 eello5_3 eello5_4 C
7646 C Antiparallel chains C
7649 C /j\ / \ \ / \ / \ / C
7650 C / \ / \ \ / \ / \ / C
7651 C j1| o |l | o | o| o | | o |o C
7652 C \ |/k\| |/ \| / |/ \| |/ \| C
7653 C \i/ \ / \ / / \ / \ C
7655 C (I) (II) (III) (IV) C
7657 C eello5_1 eello5_2 eello5_3 eello5_4 C
7659 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7661 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7662 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7667 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7669 itk=itortyp(itype(k))
7670 itl=itortyp(itype(l))
7671 itj=itortyp(itype(j))
7676 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7677 cd & eel5_3_num,eel5_4_num)
7681 derx(lll,kkk,iii)=0.0d0
7685 cd eij=facont_hb(jj,i)
7686 cd ekl=facont_hb(kk,k)
7688 cd write (iout,*)'Contacts have occurred for peptide groups',
7689 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7691 C Contribution from the graph I.
7692 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7693 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7694 call transpose2(EUg(1,1,k),auxmat(1,1))
7695 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7696 vv(1)=pizda(1,1)-pizda(2,2)
7697 vv(2)=pizda(1,2)+pizda(2,1)
7698 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7699 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7700 C Explicit gradient in virtual-dihedral angles.
7701 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7702 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7703 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7704 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7705 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7706 vv(1)=pizda(1,1)-pizda(2,2)
7707 vv(2)=pizda(1,2)+pizda(2,1)
7708 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7709 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7710 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7711 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7712 vv(1)=pizda(1,1)-pizda(2,2)
7713 vv(2)=pizda(1,2)+pizda(2,1)
7715 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7716 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7717 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7719 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7720 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7721 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7723 C Cartesian gradient
7727 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7729 vv(1)=pizda(1,1)-pizda(2,2)
7730 vv(2)=pizda(1,2)+pizda(2,1)
7731 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7732 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7733 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7739 C Contribution from graph II
7740 call transpose2(EE(1,1,itk),auxmat(1,1))
7741 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7742 vv(1)=pizda(1,1)+pizda(2,2)
7743 vv(2)=pizda(2,1)-pizda(1,2)
7744 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7745 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7746 C Explicit gradient in virtual-dihedral angles.
7747 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7748 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7749 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7750 vv(1)=pizda(1,1)+pizda(2,2)
7751 vv(2)=pizda(2,1)-pizda(1,2)
7753 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7754 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7755 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7757 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7758 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7759 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7761 C Cartesian gradient
7765 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7767 vv(1)=pizda(1,1)+pizda(2,2)
7768 vv(2)=pizda(2,1)-pizda(1,2)
7769 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7770 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7771 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7779 C Parallel orientation
7780 C Contribution from graph III
7781 call transpose2(EUg(1,1,l),auxmat(1,1))
7782 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7783 vv(1)=pizda(1,1)-pizda(2,2)
7784 vv(2)=pizda(1,2)+pizda(2,1)
7785 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7786 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7787 C Explicit gradient in virtual-dihedral angles.
7788 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7789 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7790 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7791 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7792 vv(1)=pizda(1,1)-pizda(2,2)
7793 vv(2)=pizda(1,2)+pizda(2,1)
7794 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7795 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7796 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7797 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7798 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7799 vv(1)=pizda(1,1)-pizda(2,2)
7800 vv(2)=pizda(1,2)+pizda(2,1)
7801 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7802 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7803 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7804 C Cartesian gradient
7808 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7810 vv(1)=pizda(1,1)-pizda(2,2)
7811 vv(2)=pizda(1,2)+pizda(2,1)
7812 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7813 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7814 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7819 C Contribution from graph IV
7821 call transpose2(EE(1,1,itl),auxmat(1,1))
7822 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7823 vv(1)=pizda(1,1)+pizda(2,2)
7824 vv(2)=pizda(2,1)-pizda(1,2)
7825 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7826 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7827 C Explicit gradient in virtual-dihedral angles.
7828 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7829 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7830 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7831 vv(1)=pizda(1,1)+pizda(2,2)
7832 vv(2)=pizda(2,1)-pizda(1,2)
7833 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7834 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7835 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7836 C Cartesian gradient
7840 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7842 vv(1)=pizda(1,1)+pizda(2,2)
7843 vv(2)=pizda(2,1)-pizda(1,2)
7844 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7845 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7846 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7851 C Antiparallel orientation
7852 C Contribution from graph III
7854 call transpose2(EUg(1,1,j),auxmat(1,1))
7855 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7856 vv(1)=pizda(1,1)-pizda(2,2)
7857 vv(2)=pizda(1,2)+pizda(2,1)
7858 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7859 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7860 C Explicit gradient in virtual-dihedral angles.
7861 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7862 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7863 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7864 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7865 vv(1)=pizda(1,1)-pizda(2,2)
7866 vv(2)=pizda(1,2)+pizda(2,1)
7867 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7868 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7869 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7870 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7871 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7872 vv(1)=pizda(1,1)-pizda(2,2)
7873 vv(2)=pizda(1,2)+pizda(2,1)
7874 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7875 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7876 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7877 C Cartesian gradient
7881 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7883 vv(1)=pizda(1,1)-pizda(2,2)
7884 vv(2)=pizda(1,2)+pizda(2,1)
7885 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7886 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7887 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7892 C Contribution from graph IV
7894 call transpose2(EE(1,1,itj),auxmat(1,1))
7895 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7896 vv(1)=pizda(1,1)+pizda(2,2)
7897 vv(2)=pizda(2,1)-pizda(1,2)
7898 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7899 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7900 C Explicit gradient in virtual-dihedral angles.
7901 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7902 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7903 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7904 vv(1)=pizda(1,1)+pizda(2,2)
7905 vv(2)=pizda(2,1)-pizda(1,2)
7906 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7907 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7908 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7909 C Cartesian gradient
7913 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7915 vv(1)=pizda(1,1)+pizda(2,2)
7916 vv(2)=pizda(2,1)-pizda(1,2)
7917 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7918 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7919 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7925 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7926 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7927 cd write (2,*) 'ijkl',i,j,k,l
7928 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7929 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7931 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7932 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7933 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7934 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7935 if (j.lt.nres-1) then
7942 if (l.lt.nres-1) then
7952 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7953 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7954 C summed up outside the subrouine as for the other subroutines
7955 C handling long-range interactions. The old code is commented out
7956 C with "cgrad" to keep track of changes.
7958 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7959 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7960 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7961 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7962 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7963 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7964 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7965 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7966 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7967 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7969 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7970 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7971 cgrad ghalf=0.5d0*ggg1(ll)
7973 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7974 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7975 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7976 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7977 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7978 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7979 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7980 cgrad ghalf=0.5d0*ggg2(ll)
7982 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7983 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7984 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7985 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7986 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7987 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7992 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7993 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7998 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7999 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8005 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8010 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8014 cd write (2,*) iii,g_corr5_loc(iii)
8017 cd write (2,*) 'ekont',ekont
8018 cd write (iout,*) 'eello5',ekont*eel5
8021 c--------------------------------------------------------------------------
8022 double precision function eello6(i,j,k,l,jj,kk)
8023 implicit real*8 (a-h,o-z)
8024 include 'DIMENSIONS'
8025 include 'COMMON.IOUNITS'
8026 include 'COMMON.CHAIN'
8027 include 'COMMON.DERIV'
8028 include 'COMMON.INTERACT'
8029 include 'COMMON.CONTACTS'
8030 include 'COMMON.TORSION'
8031 include 'COMMON.VAR'
8032 include 'COMMON.GEO'
8033 include 'COMMON.FFIELD'
8034 double precision ggg1(3),ggg2(3)
8035 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8040 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8048 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8049 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8053 derx(lll,kkk,iii)=0.0d0
8057 cd eij=facont_hb(jj,i)
8058 cd ekl=facont_hb(kk,k)
8064 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8065 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8066 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8067 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8068 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8069 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8071 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8072 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8073 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8074 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8075 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8076 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8080 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8082 C If turn contributions are considered, they will be handled separately.
8083 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8084 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8085 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8086 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8087 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8088 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8089 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8091 if (j.lt.nres-1) then
8098 if (l.lt.nres-1) then
8106 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8107 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8108 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8109 cgrad ghalf=0.5d0*ggg1(ll)
8111 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8112 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8113 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8114 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8115 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8116 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8117 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8118 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8119 cgrad ghalf=0.5d0*ggg2(ll)
8120 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8122 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8123 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8124 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8125 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8126 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8127 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8132 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8133 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8138 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8139 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8145 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8150 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8154 cd write (2,*) iii,g_corr6_loc(iii)
8157 cd write (2,*) 'ekont',ekont
8158 cd write (iout,*) 'eello6',ekont*eel6
8161 c--------------------------------------------------------------------------
8162 double precision function eello6_graph1(i,j,k,l,imat,swap)
8163 implicit real*8 (a-h,o-z)
8164 include 'DIMENSIONS'
8165 include 'COMMON.IOUNITS'
8166 include 'COMMON.CHAIN'
8167 include 'COMMON.DERIV'
8168 include 'COMMON.INTERACT'
8169 include 'COMMON.CONTACTS'
8170 include 'COMMON.TORSION'
8171 include 'COMMON.VAR'
8172 include 'COMMON.GEO'
8173 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8177 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8179 C Parallel Antiparallel
8185 C \ j|/k\| / \ |/k\|l /
8190 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8191 itk=itortyp(itype(k))
8192 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8193 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8194 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8195 call transpose2(EUgC(1,1,k),auxmat(1,1))
8196 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8197 vv1(1)=pizda1(1,1)-pizda1(2,2)
8198 vv1(2)=pizda1(1,2)+pizda1(2,1)
8199 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8200 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8201 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8202 s5=scalar2(vv(1),Dtobr2(1,i))
8203 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8204 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8205 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8206 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8207 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8208 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8209 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8210 & +scalar2(vv(1),Dtobr2der(1,i)))
8211 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8212 vv1(1)=pizda1(1,1)-pizda1(2,2)
8213 vv1(2)=pizda1(1,2)+pizda1(2,1)
8214 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8215 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8217 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8218 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8219 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8220 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8221 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8223 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8224 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8225 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8226 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8227 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8229 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8230 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8231 vv1(1)=pizda1(1,1)-pizda1(2,2)
8232 vv1(2)=pizda1(1,2)+pizda1(2,1)
8233 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8234 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8235 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8236 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8245 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8246 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8247 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8248 call transpose2(EUgC(1,1,k),auxmat(1,1))
8249 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8251 vv1(1)=pizda1(1,1)-pizda1(2,2)
8252 vv1(2)=pizda1(1,2)+pizda1(2,1)
8253 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8254 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8255 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8256 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8257 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8258 s5=scalar2(vv(1),Dtobr2(1,i))
8259 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8265 c----------------------------------------------------------------------------
8266 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8267 implicit real*8 (a-h,o-z)
8268 include 'DIMENSIONS'
8269 include 'COMMON.IOUNITS'
8270 include 'COMMON.CHAIN'
8271 include 'COMMON.DERIV'
8272 include 'COMMON.INTERACT'
8273 include 'COMMON.CONTACTS'
8274 include 'COMMON.TORSION'
8275 include 'COMMON.VAR'
8276 include 'COMMON.GEO'
8278 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8279 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8282 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8284 C Parallel Antiparallel C
8290 C \ j|/k\| \ |/k\|l C
8295 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8296 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8297 C AL 7/4/01 s1 would occur in the sixth-order moment,
8298 C but not in a cluster cumulant
8300 s1=dip(1,jj,i)*dip(1,kk,k)
8302 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8303 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8304 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8305 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8306 call transpose2(EUg(1,1,k),auxmat(1,1))
8307 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8308 vv(1)=pizda(1,1)-pizda(2,2)
8309 vv(2)=pizda(1,2)+pizda(2,1)
8310 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8311 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8313 eello6_graph2=-(s1+s2+s3+s4)
8315 eello6_graph2=-(s2+s3+s4)
8318 C Derivatives in gamma(i-1)
8321 s1=dipderg(1,jj,i)*dip(1,kk,k)
8323 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8324 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8325 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8326 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8328 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8330 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8332 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8334 C Derivatives in gamma(k-1)
8336 s1=dip(1,jj,i)*dipderg(1,kk,k)
8338 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8339 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8340 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8341 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8342 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8343 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8344 vv(1)=pizda(1,1)-pizda(2,2)
8345 vv(2)=pizda(1,2)+pizda(2,1)
8346 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8348 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8350 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8352 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8353 C Derivatives in gamma(j-1) or gamma(l-1)
8356 s1=dipderg(3,jj,i)*dip(1,kk,k)
8358 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8359 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8360 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8361 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8362 vv(1)=pizda(1,1)-pizda(2,2)
8363 vv(2)=pizda(1,2)+pizda(2,1)
8364 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8367 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8369 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8372 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8373 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8375 C Derivatives in gamma(l-1) or gamma(j-1)
8378 s1=dip(1,jj,i)*dipderg(3,kk,k)
8380 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8381 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8382 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8383 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8384 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8385 vv(1)=pizda(1,1)-pizda(2,2)
8386 vv(2)=pizda(1,2)+pizda(2,1)
8387 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8390 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8392 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8395 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8396 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8398 C Cartesian derivatives.
8400 write (2,*) 'In eello6_graph2'
8402 write (2,*) 'iii=',iii
8404 write (2,*) 'kkk=',kkk
8406 write (2,'(3(2f10.5),5x)')
8407 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8417 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8419 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8422 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8424 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8425 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8427 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8428 call transpose2(EUg(1,1,k),auxmat(1,1))
8429 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8431 vv(1)=pizda(1,1)-pizda(2,2)
8432 vv(2)=pizda(1,2)+pizda(2,1)
8433 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8434 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8436 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8438 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8441 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8443 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8450 c----------------------------------------------------------------------------
8451 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8452 implicit real*8 (a-h,o-z)
8453 include 'DIMENSIONS'
8454 include 'COMMON.IOUNITS'
8455 include 'COMMON.CHAIN'
8456 include 'COMMON.DERIV'
8457 include 'COMMON.INTERACT'
8458 include 'COMMON.CONTACTS'
8459 include 'COMMON.TORSION'
8460 include 'COMMON.VAR'
8461 include 'COMMON.GEO'
8462 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8464 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8466 C Parallel Antiparallel C
8472 C j|/k\| / |/k\|l / C
8477 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8479 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8480 C energy moment and not to the cluster cumulant.
8481 iti=itortyp(itype(i))
8482 if (j.lt.nres-1) then
8483 itj1=itortyp(itype(j+1))
8487 itk=itortyp(itype(k))
8488 itk1=itortyp(itype(k+1))
8489 if (l.lt.nres-1) then
8490 itl1=itortyp(itype(l+1))
8495 s1=dip(4,jj,i)*dip(4,kk,k)
8497 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8498 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8499 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8500 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8501 call transpose2(EE(1,1,itk),auxmat(1,1))
8502 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8503 vv(1)=pizda(1,1)+pizda(2,2)
8504 vv(2)=pizda(2,1)-pizda(1,2)
8505 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8506 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8507 cd & "sum",-(s2+s3+s4)
8509 eello6_graph3=-(s1+s2+s3+s4)
8511 eello6_graph3=-(s2+s3+s4)
8514 C Derivatives in gamma(k-1)
8515 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8516 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8517 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8518 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8519 C Derivatives in gamma(l-1)
8520 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8521 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8522 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8523 vv(1)=pizda(1,1)+pizda(2,2)
8524 vv(2)=pizda(2,1)-pizda(1,2)
8525 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8526 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8527 C Cartesian derivatives.
8533 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8535 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8538 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8540 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8541 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8543 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8544 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8546 vv(1)=pizda(1,1)+pizda(2,2)
8547 vv(2)=pizda(2,1)-pizda(1,2)
8548 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8550 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8552 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8555 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8557 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8559 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8565 c----------------------------------------------------------------------------
8566 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8567 implicit real*8 (a-h,o-z)
8568 include 'DIMENSIONS'
8569 include 'COMMON.IOUNITS'
8570 include 'COMMON.CHAIN'
8571 include 'COMMON.DERIV'
8572 include 'COMMON.INTERACT'
8573 include 'COMMON.CONTACTS'
8574 include 'COMMON.TORSION'
8575 include 'COMMON.VAR'
8576 include 'COMMON.GEO'
8577 include 'COMMON.FFIELD'
8578 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8579 & auxvec1(2),auxmat1(2,2)
8581 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8583 C Parallel Antiparallel C
8589 C \ j|/k\| \ |/k\|l C
8594 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8596 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8597 C energy moment and not to the cluster cumulant.
8598 cd write (2,*) 'eello_graph4: wturn6',wturn6
8599 iti=itortyp(itype(i))
8600 itj=itortyp(itype(j))
8601 if (j.lt.nres-1) then
8602 itj1=itortyp(itype(j+1))
8606 itk=itortyp(itype(k))
8607 if (k.lt.nres-1) then
8608 itk1=itortyp(itype(k+1))
8612 itl=itortyp(itype(l))
8613 if (l.lt.nres-1) then
8614 itl1=itortyp(itype(l+1))
8618 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8619 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8620 cd & ' itl',itl,' itl1',itl1
8623 s1=dip(3,jj,i)*dip(3,kk,k)
8625 s1=dip(2,jj,j)*dip(2,kk,l)
8628 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8629 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8631 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8632 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8634 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8635 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8637 call transpose2(EUg(1,1,k),auxmat(1,1))
8638 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8639 vv(1)=pizda(1,1)-pizda(2,2)
8640 vv(2)=pizda(2,1)+pizda(1,2)
8641 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8642 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8644 eello6_graph4=-(s1+s2+s3+s4)
8646 eello6_graph4=-(s2+s3+s4)
8648 C Derivatives in gamma(i-1)
8652 s1=dipderg(2,jj,i)*dip(3,kk,k)
8654 s1=dipderg(4,jj,j)*dip(2,kk,l)
8657 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8659 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8660 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8662 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8663 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8665 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8666 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8667 cd write (2,*) 'turn6 derivatives'
8669 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8671 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8675 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8677 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8681 C Derivatives in gamma(k-1)
8684 s1=dip(3,jj,i)*dipderg(2,kk,k)
8686 s1=dip(2,jj,j)*dipderg(4,kk,l)
8689 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8690 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8692 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8693 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8695 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8696 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8698 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8699 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8700 vv(1)=pizda(1,1)-pizda(2,2)
8701 vv(2)=pizda(2,1)+pizda(1,2)
8702 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8703 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8705 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8707 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8711 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8713 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8716 C Derivatives in gamma(j-1) or gamma(l-1)
8717 if (l.eq.j+1 .and. l.gt.1) then
8718 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8719 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8720 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8721 vv(1)=pizda(1,1)-pizda(2,2)
8722 vv(2)=pizda(2,1)+pizda(1,2)
8723 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8724 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8725 else if (j.gt.1) then
8726 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8727 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8728 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8729 vv(1)=pizda(1,1)-pizda(2,2)
8730 vv(2)=pizda(2,1)+pizda(1,2)
8731 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8732 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8733 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8735 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8738 C Cartesian derivatives.
8745 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8747 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8751 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8753 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8757 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8759 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8761 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8762 & b1(1,itj1),auxvec(1))
8763 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8765 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8766 & b1(1,itl1),auxvec(1))
8767 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8769 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8771 vv(1)=pizda(1,1)-pizda(2,2)
8772 vv(2)=pizda(2,1)+pizda(1,2)
8773 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8775 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8777 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8780 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8783 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8786 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8788 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8790 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8794 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8796 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8799 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8801 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8809 c----------------------------------------------------------------------------
8810 double precision function eello_turn6(i,jj,kk)
8811 implicit real*8 (a-h,o-z)
8812 include 'DIMENSIONS'
8813 include 'COMMON.IOUNITS'
8814 include 'COMMON.CHAIN'
8815 include 'COMMON.DERIV'
8816 include 'COMMON.INTERACT'
8817 include 'COMMON.CONTACTS'
8818 include 'COMMON.TORSION'
8819 include 'COMMON.VAR'
8820 include 'COMMON.GEO'
8821 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8822 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8824 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8825 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8826 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8827 C the respective energy moment and not to the cluster cumulant.
8836 iti=itortyp(itype(i))
8837 itk=itortyp(itype(k))
8838 itk1=itortyp(itype(k+1))
8839 itl=itortyp(itype(l))
8840 itj=itortyp(itype(j))
8841 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8842 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8843 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8848 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8850 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8854 derx_turn(lll,kkk,iii)=0.0d0
8861 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8863 cd write (2,*) 'eello6_5',eello6_5
8865 call transpose2(AEA(1,1,1),auxmat(1,1))
8866 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8867 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8868 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8870 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8871 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8872 s2 = scalar2(b1(1,itk),vtemp1(1))
8874 call transpose2(AEA(1,1,2),atemp(1,1))
8875 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8876 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8877 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8879 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8880 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8881 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8883 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8884 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8885 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8886 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8887 ss13 = scalar2(b1(1,itk),vtemp4(1))
8888 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8890 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8896 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8897 C Derivatives in gamma(i+2)
8901 call transpose2(AEA(1,1,1),auxmatd(1,1))
8902 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8903 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8904 call transpose2(AEAderg(1,1,2),atempd(1,1))
8905 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8906 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8908 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8909 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8910 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8916 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8917 C Derivatives in gamma(i+3)
8919 call transpose2(AEA(1,1,1),auxmatd(1,1))
8920 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8921 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8922 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8924 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8925 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8926 s2d = scalar2(b1(1,itk),vtemp1d(1))
8928 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8929 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8931 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8933 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8934 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8935 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8943 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8944 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8946 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8947 & -0.5d0*ekont*(s2d+s12d)
8949 C Derivatives in gamma(i+4)
8950 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8951 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8952 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8954 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8955 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8956 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8964 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8966 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8968 C Derivatives in gamma(i+5)
8970 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8971 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8972 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8974 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8975 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8976 s2d = scalar2(b1(1,itk),vtemp1d(1))
8978 call transpose2(AEA(1,1,2),atempd(1,1))
8979 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8980 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8982 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8983 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8985 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8986 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8987 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8995 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8996 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8998 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8999 & -0.5d0*ekont*(s2d+s12d)
9001 C Cartesian derivatives
9006 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9007 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9008 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9010 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9011 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9013 s2d = scalar2(b1(1,itk),vtemp1d(1))
9015 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9016 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9017 s8d = -(atempd(1,1)+atempd(2,2))*
9018 & scalar2(cc(1,1,itl),vtemp2(1))
9020 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9022 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9023 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9030 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9033 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9037 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9038 & - 0.5d0*(s8d+s12d)
9040 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9049 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9051 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9052 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9053 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9054 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9055 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9057 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9058 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9059 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9063 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9064 cd & 16*eel_turn6_num
9066 if (j.lt.nres-1) then
9073 if (l.lt.nres-1) then
9081 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9082 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9083 cgrad ghalf=0.5d0*ggg1(ll)
9085 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9086 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9087 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9088 & +ekont*derx_turn(ll,2,1)
9089 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9090 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9091 & +ekont*derx_turn(ll,4,1)
9092 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9093 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9094 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9095 cgrad ghalf=0.5d0*ggg2(ll)
9097 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9098 & +ekont*derx_turn(ll,2,2)
9099 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9100 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9101 & +ekont*derx_turn(ll,4,2)
9102 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9103 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9104 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9109 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9114 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9120 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9125 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9129 cd write (2,*) iii,g_corr6_loc(iii)
9131 eello_turn6=ekont*eel_turn6
9132 cd write (2,*) 'ekont',ekont
9133 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9137 C-----------------------------------------------------------------------------
9138 double precision function scalar(u,v)
9139 !DIR$ INLINEALWAYS scalar
9141 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9144 double precision u(3),v(3)
9145 cd double precision sc
9153 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9156 crc-------------------------------------------------
9157 SUBROUTINE MATVEC2(A1,V1,V2)
9158 !DIR$ INLINEALWAYS MATVEC2
9160 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9162 implicit real*8 (a-h,o-z)
9163 include 'DIMENSIONS'
9164 DIMENSION A1(2,2),V1(2),V2(2)
9168 c 3 VI=VI+A1(I,K)*V1(K)
9172 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9173 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9178 C---------------------------------------
9179 SUBROUTINE MATMAT2(A1,A2,A3)
9181 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9183 implicit real*8 (a-h,o-z)
9184 include 'DIMENSIONS'
9185 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9186 c DIMENSION AI3(2,2)
9190 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9196 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9197 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9198 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9199 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9207 c-------------------------------------------------------------------------
9208 double precision function scalar2(u,v)
9209 !DIR$ INLINEALWAYS scalar2
9211 double precision u(2),v(2)
9214 scalar2=u(1)*v(1)+u(2)*v(2)
9218 C-----------------------------------------------------------------------------
9220 subroutine transpose2(a,at)
9221 !DIR$ INLINEALWAYS transpose2
9223 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9226 double precision a(2,2),at(2,2)
9233 c--------------------------------------------------------------------------
9234 subroutine transpose(n,a,at)
9237 double precision a(n,n),at(n,n)
9245 C---------------------------------------------------------------------------
9246 subroutine prodmat3(a1,a2,kk,transp,prod)
9247 !DIR$ INLINEALWAYS prodmat3
9249 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9253 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9255 crc double precision auxmat(2,2),prod_(2,2)
9258 crc call transpose2(kk(1,1),auxmat(1,1))
9259 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9260 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9262 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9263 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9264 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9265 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9266 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9267 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9268 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9269 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9272 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9273 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9275 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9276 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9277 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9278 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9279 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9280 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9281 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9282 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9285 c call transpose2(a2(1,1),a2t(1,1))
9288 crc print *,((prod_(i,j),i=1,2),j=1,2)
9289 crc print *,((prod(i,j),i=1,2),j=1,2)