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'
1598 c dscj_inv=dsc_inv(itypj)
1599 dscj_inv=vbld_inv(j+nres)
1600 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1601 c & 1.0d0/vbld(j+nres)
1602 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1603 sig0ij=sigma(itypi,itypj)
1604 chi1=chi(itypi,itypj)
1605 chi2=chi(itypj,itypi)
1612 alf12=0.5D0*(alf1+alf2)
1613 C For diagnostics only!!!
1626 dxj=dc_norm(1,nres+j)
1627 dyj=dc_norm(2,nres+j)
1628 dzj=dc_norm(3,nres+j)
1629 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1630 c write (iout,*) "j",j," dc_norm",
1631 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1632 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1634 C Calculate angle-dependent terms of energy and contributions to their
1638 sig=sig0ij*dsqrt(sigsq)
1639 rij_shift=1.0D0/rij-sig+sig0ij
1640 c for diagnostics; uncomment
1641 c rij_shift=1.2*sig0ij
1642 C I hate to put IF's in the loops, but here don't have another choice!!!!
1643 if (rij_shift.le.0.0D0) then
1645 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1646 cd & restyp(itypi),i,restyp(itypj),j,
1647 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1651 c---------------------------------------------------------------
1652 rij_shift=1.0D0/rij_shift
1653 fac=rij_shift**expon
1654 e1=fac*fac*aa(itypi,itypj)
1655 e2=fac*bb(itypi,itypj)
1656 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1657 eps2der=evdwij*eps3rt
1658 eps3der=evdwij*eps2rt
1659 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1660 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1661 evdwij=evdwij*eps2rt*eps3rt
1663 if (bb(itypi,itypj).gt.0) then
1664 evdw_p=evdw_p+evdwij
1666 evdw_m=evdw_m+evdwij
1672 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1673 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1674 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1675 & restyp(itypi),i,restyp(itypj),j,
1676 & epsi,sigm,chi1,chi2,chip1,chip2,
1677 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1678 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1682 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1685 C Calculate gradient components.
1686 e1=e1*eps1*eps2rt**2*eps3rt**2
1687 fac=-expon*(e1+evdwij)*rij_shift
1691 C Calculate the radial part of the gradient
1695 C Calculate angular part of the gradient.
1697 if (bb(itypi,itypj).gt.0) then
1709 c write (iout,*) "Number of loop steps in EGB:",ind
1710 cccc energy_dec=.false.
1713 C-----------------------------------------------------------------------------
1714 subroutine egbv(evdw,evdw_p,evdw_m)
1716 C This subroutine calculates the interaction energy of nonbonded side chains
1717 C assuming the Gay-Berne-Vorobjev potential of interaction.
1719 implicit real*8 (a-h,o-z)
1720 include 'DIMENSIONS'
1721 include 'COMMON.GEO'
1722 include 'COMMON.VAR'
1723 include 'COMMON.LOCAL'
1724 include 'COMMON.CHAIN'
1725 include 'COMMON.DERIV'
1726 include 'COMMON.NAMES'
1727 include 'COMMON.INTERACT'
1728 include 'COMMON.IOUNITS'
1729 include 'COMMON.CALC'
1730 common /srutu/ icall
1733 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1736 c if (icall.eq.0) lprn=.true.
1738 do i=iatsc_s,iatsc_e
1744 dxi=dc_norm(1,nres+i)
1745 dyi=dc_norm(2,nres+i)
1746 dzi=dc_norm(3,nres+i)
1747 c dsci_inv=dsc_inv(itypi)
1748 dsci_inv=vbld_inv(i+nres)
1750 C Calculate SC interaction energy.
1752 do iint=1,nint_gr(i)
1753 do j=istart(i,iint),iend(i,iint)
1756 c dscj_inv=dsc_inv(itypj)
1757 dscj_inv=vbld_inv(j+nres)
1758 sig0ij=sigma(itypi,itypj)
1759 r0ij=r0(itypi,itypj)
1760 chi1=chi(itypi,itypj)
1761 chi2=chi(itypj,itypi)
1768 alf12=0.5D0*(alf1+alf2)
1769 C For diagnostics only!!!
1782 dxj=dc_norm(1,nres+j)
1783 dyj=dc_norm(2,nres+j)
1784 dzj=dc_norm(3,nres+j)
1785 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1787 C Calculate angle-dependent terms of energy and contributions to their
1791 sig=sig0ij*dsqrt(sigsq)
1792 rij_shift=1.0D0/rij-sig+r0ij
1793 C I hate to put IF's in the loops, but here don't have another choice!!!!
1794 if (rij_shift.le.0.0D0) then
1799 c---------------------------------------------------------------
1800 rij_shift=1.0D0/rij_shift
1801 fac=rij_shift**expon
1802 e1=fac*fac*aa(itypi,itypj)
1803 e2=fac*bb(itypi,itypj)
1804 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1805 eps2der=evdwij*eps3rt
1806 eps3der=evdwij*eps2rt
1807 fac_augm=rrij**expon
1808 e_augm=augm(itypi,itypj)*fac_augm
1809 evdwij=evdwij*eps2rt*eps3rt
1811 if (bb(itypi,itypj).gt.0) then
1812 evdw_p=evdw_p+evdwij+e_augm
1814 evdw_m=evdw_m+evdwij+e_augm
1817 evdw=evdw+evdwij+e_augm
1820 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1821 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1822 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1823 & restyp(itypi),i,restyp(itypj),j,
1824 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1825 & chi1,chi2,chip1,chip2,
1826 & eps1,eps2rt**2,eps3rt**2,
1827 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1830 C Calculate gradient components.
1831 e1=e1*eps1*eps2rt**2*eps3rt**2
1832 fac=-expon*(e1+evdwij)*rij_shift
1834 fac=rij*fac-2*expon*rrij*e_augm
1835 C Calculate the radial part of the gradient
1839 C Calculate angular part of the gradient.
1841 if (bb(itypi,itypj).gt.0) then
1853 C-----------------------------------------------------------------------------
1854 subroutine sc_angular
1855 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1856 C om12. Called by ebp, egb, and egbv.
1858 include 'COMMON.CALC'
1859 include 'COMMON.IOUNITS'
1863 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1864 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1865 om12=dxi*dxj+dyi*dyj+dzi*dzj
1867 C Calculate eps1(om12) and its derivative in om12
1868 faceps1=1.0D0-om12*chiom12
1869 faceps1_inv=1.0D0/faceps1
1870 eps1=dsqrt(faceps1_inv)
1871 C Following variable is eps1*deps1/dom12
1872 eps1_om12=faceps1_inv*chiom12
1877 c write (iout,*) "om12",om12," eps1",eps1
1878 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1883 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1884 sigsq=1.0D0-facsig*faceps1_inv
1885 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1886 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1887 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1893 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1894 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1896 C Calculate eps2 and its derivatives in om1, om2, and om12.
1899 chipom12=chip12*om12
1900 facp=1.0D0-om12*chipom12
1902 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1903 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1904 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1905 C Following variable is the square root of eps2
1906 eps2rt=1.0D0-facp1*facp_inv
1907 C Following three variables are the derivatives of the square root of eps
1908 C in om1, om2, and om12.
1909 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1910 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1911 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1912 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1913 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1914 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1915 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1916 c & " eps2rt_om12",eps2rt_om12
1917 C Calculate whole angle-dependent part of epsilon and contributions
1918 C to its derivatives
1922 C----------------------------------------------------------------------------
1923 subroutine sc_grad_T
1924 implicit real*8 (a-h,o-z)
1925 include 'DIMENSIONS'
1926 include 'COMMON.CHAIN'
1927 include 'COMMON.DERIV'
1928 include 'COMMON.CALC'
1929 include 'COMMON.IOUNITS'
1930 double precision dcosom1(3),dcosom2(3)
1931 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1932 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1933 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1934 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1938 c eom12=evdwij*eps1_om12
1940 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1941 c & " sigder",sigder
1942 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1943 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1945 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1946 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1949 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1951 c write (iout,*) "gg",(gg(k),k=1,3)
1953 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1954 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1955 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1956 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1957 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1958 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1959 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1960 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1961 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1962 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1965 C Calculate the components of the gradient in DC and X
1969 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1973 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1974 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1979 C----------------------------------------------------------------------------
1981 implicit real*8 (a-h,o-z)
1982 include 'DIMENSIONS'
1983 include 'COMMON.CHAIN'
1984 include 'COMMON.DERIV'
1985 include 'COMMON.CALC'
1986 include 'COMMON.IOUNITS'
1987 double precision dcosom1(3),dcosom2(3)
1988 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1989 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1990 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1991 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1995 c eom12=evdwij*eps1_om12
1997 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1998 c & " sigder",sigder
1999 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2000 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2002 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2003 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2006 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2008 c write (iout,*) "gg",(gg(k),k=1,3)
2010 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2011 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2012 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2013 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2014 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2015 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2016 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2017 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2018 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2019 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2022 C Calculate the components of the gradient in DC and X
2026 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2030 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2031 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2035 C-----------------------------------------------------------------------
2036 subroutine e_softsphere(evdw)
2038 C This subroutine calculates the interaction energy of nonbonded side chains
2039 C assuming the LJ potential of interaction.
2041 implicit real*8 (a-h,o-z)
2042 include 'DIMENSIONS'
2043 parameter (accur=1.0d-10)
2044 include 'COMMON.GEO'
2045 include 'COMMON.VAR'
2046 include 'COMMON.LOCAL'
2047 include 'COMMON.CHAIN'
2048 include 'COMMON.DERIV'
2049 include 'COMMON.INTERACT'
2050 include 'COMMON.TORSION'
2051 include 'COMMON.SBRIDGE'
2052 include 'COMMON.NAMES'
2053 include 'COMMON.IOUNITS'
2054 include 'COMMON.CONTACTS'
2056 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2058 do i=iatsc_s,iatsc_e
2065 C Calculate SC interaction energy.
2067 do iint=1,nint_gr(i)
2068 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2069 cd & 'iend=',iend(i,iint)
2070 do j=istart(i,iint),iend(i,iint)
2075 rij=xj*xj+yj*yj+zj*zj
2076 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2077 r0ij=r0(itypi,itypj)
2079 c print *,i,j,r0ij,dsqrt(rij)
2080 if (rij.lt.r0ijsq) then
2081 evdwij=0.25d0*(rij-r0ijsq)**2
2089 C Calculate the components of the gradient in DC and X
2095 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2096 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2097 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2098 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2102 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2110 C--------------------------------------------------------------------------
2111 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2114 C Soft-sphere potential of p-p interaction
2116 implicit real*8 (a-h,o-z)
2117 include 'DIMENSIONS'
2118 include 'COMMON.CONTROL'
2119 include 'COMMON.IOUNITS'
2120 include 'COMMON.GEO'
2121 include 'COMMON.VAR'
2122 include 'COMMON.LOCAL'
2123 include 'COMMON.CHAIN'
2124 include 'COMMON.DERIV'
2125 include 'COMMON.INTERACT'
2126 include 'COMMON.CONTACTS'
2127 include 'COMMON.TORSION'
2128 include 'COMMON.VECTORS'
2129 include 'COMMON.FFIELD'
2131 cd write(iout,*) 'In EELEC_soft_sphere'
2138 do i=iatel_s,iatel_e
2142 xmedi=c(1,i)+0.5d0*dxi
2143 ymedi=c(2,i)+0.5d0*dyi
2144 zmedi=c(3,i)+0.5d0*dzi
2146 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2147 do j=ielstart(i),ielend(i)
2151 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2152 r0ij=rpp(iteli,itelj)
2157 xj=c(1,j)+0.5D0*dxj-xmedi
2158 yj=c(2,j)+0.5D0*dyj-ymedi
2159 zj=c(3,j)+0.5D0*dzj-zmedi
2160 rij=xj*xj+yj*yj+zj*zj
2161 if (rij.lt.r0ijsq) then
2162 evdw1ij=0.25d0*(rij-r0ijsq)**2
2170 C Calculate contributions to the Cartesian gradient.
2176 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2177 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2180 * Loop over residues i+1 thru j-1.
2184 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2189 cgrad do i=nnt,nct-1
2191 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2193 cgrad do j=i+1,nct-1
2195 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2201 c------------------------------------------------------------------------------
2202 subroutine vec_and_deriv
2203 implicit real*8 (a-h,o-z)
2204 include 'DIMENSIONS'
2208 include 'COMMON.IOUNITS'
2209 include 'COMMON.GEO'
2210 include 'COMMON.VAR'
2211 include 'COMMON.LOCAL'
2212 include 'COMMON.CHAIN'
2213 include 'COMMON.VECTORS'
2214 include 'COMMON.SETUP'
2215 include 'COMMON.TIME1'
2216 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2217 C Compute the local reference systems. For reference system (i), the
2218 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2219 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2221 do i=ivec_start,ivec_end
2225 if (i.eq.nres-1) then
2226 C Case of the last full residue
2227 C Compute the Z-axis
2228 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2229 costh=dcos(pi-theta(nres))
2230 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2234 C Compute the derivatives of uz
2236 uzder(2,1,1)=-dc_norm(3,i-1)
2237 uzder(3,1,1)= dc_norm(2,i-1)
2238 uzder(1,2,1)= dc_norm(3,i-1)
2240 uzder(3,2,1)=-dc_norm(1,i-1)
2241 uzder(1,3,1)=-dc_norm(2,i-1)
2242 uzder(2,3,1)= dc_norm(1,i-1)
2245 uzder(2,1,2)= dc_norm(3,i)
2246 uzder(3,1,2)=-dc_norm(2,i)
2247 uzder(1,2,2)=-dc_norm(3,i)
2249 uzder(3,2,2)= dc_norm(1,i)
2250 uzder(1,3,2)= dc_norm(2,i)
2251 uzder(2,3,2)=-dc_norm(1,i)
2253 C Compute the Y-axis
2256 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2258 C Compute the derivatives of uy
2261 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2262 & -dc_norm(k,i)*dc_norm(j,i-1)
2263 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2265 uyder(j,j,1)=uyder(j,j,1)-costh
2266 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2271 uygrad(l,k,j,i)=uyder(l,k,j)
2272 uzgrad(l,k,j,i)=uzder(l,k,j)
2276 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2277 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2278 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2279 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2282 C Compute the Z-axis
2283 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2284 costh=dcos(pi-theta(i+2))
2285 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2289 C Compute the derivatives of uz
2291 uzder(2,1,1)=-dc_norm(3,i+1)
2292 uzder(3,1,1)= dc_norm(2,i+1)
2293 uzder(1,2,1)= dc_norm(3,i+1)
2295 uzder(3,2,1)=-dc_norm(1,i+1)
2296 uzder(1,3,1)=-dc_norm(2,i+1)
2297 uzder(2,3,1)= dc_norm(1,i+1)
2300 uzder(2,1,2)= dc_norm(3,i)
2301 uzder(3,1,2)=-dc_norm(2,i)
2302 uzder(1,2,2)=-dc_norm(3,i)
2304 uzder(3,2,2)= dc_norm(1,i)
2305 uzder(1,3,2)= dc_norm(2,i)
2306 uzder(2,3,2)=-dc_norm(1,i)
2308 C Compute the Y-axis
2311 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2313 C Compute the derivatives of uy
2316 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2317 & -dc_norm(k,i)*dc_norm(j,i+1)
2318 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2320 uyder(j,j,1)=uyder(j,j,1)-costh
2321 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2326 uygrad(l,k,j,i)=uyder(l,k,j)
2327 uzgrad(l,k,j,i)=uzder(l,k,j)
2331 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2332 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2333 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2334 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2338 vbld_inv_temp(1)=vbld_inv(i+1)
2339 if (i.lt.nres-1) then
2340 vbld_inv_temp(2)=vbld_inv(i+2)
2342 vbld_inv_temp(2)=vbld_inv(i)
2347 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2348 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2353 #if defined(PARVEC) && defined(MPI)
2354 if (nfgtasks1.gt.1) then
2356 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2357 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2358 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2359 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2360 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2362 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2363 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2365 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2366 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2367 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2368 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2369 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2370 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2371 time_gather=time_gather+MPI_Wtime()-time00
2373 c if (fg_rank.eq.0) then
2374 c write (iout,*) "Arrays UY and UZ"
2376 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2383 C-----------------------------------------------------------------------------
2384 subroutine check_vecgrad
2385 implicit real*8 (a-h,o-z)
2386 include 'DIMENSIONS'
2387 include 'COMMON.IOUNITS'
2388 include 'COMMON.GEO'
2389 include 'COMMON.VAR'
2390 include 'COMMON.LOCAL'
2391 include 'COMMON.CHAIN'
2392 include 'COMMON.VECTORS'
2393 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2394 dimension uyt(3,maxres),uzt(3,maxres)
2395 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2396 double precision delta /1.0d-7/
2399 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2400 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2401 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2402 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2403 cd & (dc_norm(if90,i),if90=1,3)
2404 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2405 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2406 cd write(iout,'(a)')
2412 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2413 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2426 cd write (iout,*) 'i=',i
2428 erij(k)=dc_norm(k,i)
2432 dc_norm(k,i)=erij(k)
2434 dc_norm(j,i)=dc_norm(j,i)+delta
2435 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2437 c dc_norm(k,i)=dc_norm(k,i)/fac
2439 c write (iout,*) (dc_norm(k,i),k=1,3)
2440 c write (iout,*) (erij(k),k=1,3)
2443 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2444 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2445 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2446 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2448 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2449 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2450 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2453 dc_norm(k,i)=erij(k)
2456 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2457 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2458 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2459 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2460 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2461 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2462 cd write (iout,'(a)')
2467 C--------------------------------------------------------------------------
2468 subroutine set_matrices
2469 implicit real*8 (a-h,o-z)
2470 include 'DIMENSIONS'
2473 include "COMMON.SETUP"
2475 integer status(MPI_STATUS_SIZE)
2477 include 'COMMON.IOUNITS'
2478 include 'COMMON.GEO'
2479 include 'COMMON.VAR'
2480 include 'COMMON.LOCAL'
2481 include 'COMMON.CHAIN'
2482 include 'COMMON.DERIV'
2483 include 'COMMON.INTERACT'
2484 include 'COMMON.CONTACTS'
2485 include 'COMMON.TORSION'
2486 include 'COMMON.VECTORS'
2487 include 'COMMON.FFIELD'
2488 double precision auxvec(2),auxmat(2,2)
2490 C Compute the virtual-bond-torsional-angle dependent quantities needed
2491 C to calculate the el-loc multibody terms of various order.
2494 do i=ivec_start+2,ivec_end+2
2498 if (i .lt. nres+1) then
2535 if (i .gt. 3 .and. i .lt. nres+1) then
2536 obrot_der(1,i-2)=-sin1
2537 obrot_der(2,i-2)= cos1
2538 Ugder(1,1,i-2)= sin1
2539 Ugder(1,2,i-2)=-cos1
2540 Ugder(2,1,i-2)=-cos1
2541 Ugder(2,2,i-2)=-sin1
2544 obrot2_der(1,i-2)=-dwasin2
2545 obrot2_der(2,i-2)= dwacos2
2546 Ug2der(1,1,i-2)= dwasin2
2547 Ug2der(1,2,i-2)=-dwacos2
2548 Ug2der(2,1,i-2)=-dwacos2
2549 Ug2der(2,2,i-2)=-dwasin2
2551 obrot_der(1,i-2)=0.0d0
2552 obrot_der(2,i-2)=0.0d0
2553 Ugder(1,1,i-2)=0.0d0
2554 Ugder(1,2,i-2)=0.0d0
2555 Ugder(2,1,i-2)=0.0d0
2556 Ugder(2,2,i-2)=0.0d0
2557 obrot2_der(1,i-2)=0.0d0
2558 obrot2_der(2,i-2)=0.0d0
2559 Ug2der(1,1,i-2)=0.0d0
2560 Ug2der(1,2,i-2)=0.0d0
2561 Ug2der(2,1,i-2)=0.0d0
2562 Ug2der(2,2,i-2)=0.0d0
2564 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2565 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2566 iti = itortyp(itype(i-2))
2570 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2571 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2572 iti1 = itortyp(itype(i-1))
2576 cd write (iout,*) '*******i',i,' iti1',iti
2577 cd write (iout,*) 'b1',b1(:,iti)
2578 cd write (iout,*) 'b2',b2(:,iti)
2579 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2580 c if (i .gt. iatel_s+2) then
2581 if (i .gt. nnt+2) then
2582 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2583 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2584 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2586 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2587 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2588 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2589 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2590 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2601 DtUg2(l,k,i-2)=0.0d0
2605 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2606 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2608 muder(k,i-2)=Ub2der(k,i-2)
2610 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2611 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2612 iti1 = itortyp(itype(i-1))
2617 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2619 cd write (iout,*) 'mu ',mu(:,i-2)
2620 cd write (iout,*) 'mu1',mu1(:,i-2)
2621 cd write (iout,*) 'mu2',mu2(:,i-2)
2622 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2624 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2625 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2626 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2627 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2628 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2629 C Vectors and matrices dependent on a single virtual-bond dihedral.
2630 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2631 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2632 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2633 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2634 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2635 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2636 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2637 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2638 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2641 C Matrices dependent on two consecutive virtual-bond dihedrals.
2642 C The order of matrices is from left to right.
2643 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2645 c do i=max0(ivec_start,2),ivec_end
2647 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2648 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2649 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2650 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2651 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2652 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2653 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2654 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2657 #if defined(MPI) && defined(PARMAT)
2659 c if (fg_rank.eq.0) then
2660 write (iout,*) "Arrays UG and UGDER before GATHER"
2662 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2663 & ((ug(l,k,i),l=1,2),k=1,2),
2664 & ((ugder(l,k,i),l=1,2),k=1,2)
2666 write (iout,*) "Arrays UG2 and UG2DER"
2668 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2669 & ((ug2(l,k,i),l=1,2),k=1,2),
2670 & ((ug2der(l,k,i),l=1,2),k=1,2)
2672 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2674 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2675 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2676 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2678 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2680 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2681 & costab(i),sintab(i),costab2(i),sintab2(i)
2683 write (iout,*) "Array MUDER"
2685 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2689 if (nfgtasks.gt.1) then
2691 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2692 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2693 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2695 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2696 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2698 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2699 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2701 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2702 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2704 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2705 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2707 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2708 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2710 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2711 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2713 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2714 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2715 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2716 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2717 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2718 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2719 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2720 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2721 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2722 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2723 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2724 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2725 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2727 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2728 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2730 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2731 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2733 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2734 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2736 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2737 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2739 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2740 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2742 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2743 & ivec_count(fg_rank1),
2744 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2746 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2747 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2749 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2750 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2752 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2753 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2755 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2756 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2758 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2759 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2761 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2762 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2764 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2765 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2767 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2768 & ivec_count(fg_rank1),
2769 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2771 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2772 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2774 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2775 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2777 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2778 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2780 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2781 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2783 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2784 & ivec_count(fg_rank1),
2785 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2787 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2788 & ivec_count(fg_rank1),
2789 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2791 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2792 & ivec_count(fg_rank1),
2793 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2794 & MPI_MAT2,FG_COMM1,IERR)
2795 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2796 & ivec_count(fg_rank1),
2797 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2798 & MPI_MAT2,FG_COMM1,IERR)
2801 c Passes matrix info through the ring
2804 if (irecv.lt.0) irecv=nfgtasks1-1
2807 if (inext.ge.nfgtasks1) inext=0
2809 c write (iout,*) "isend",isend," irecv",irecv
2811 lensend=lentyp(isend)
2812 lenrecv=lentyp(irecv)
2813 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2814 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2815 c & MPI_ROTAT1(lensend),inext,2200+isend,
2816 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2817 c & iprev,2200+irecv,FG_COMM,status,IERR)
2818 c write (iout,*) "Gather ROTAT1"
2820 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2821 c & MPI_ROTAT2(lensend),inext,3300+isend,
2822 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2823 c & iprev,3300+irecv,FG_COMM,status,IERR)
2824 c write (iout,*) "Gather ROTAT2"
2826 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2827 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2828 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2829 & iprev,4400+irecv,FG_COMM,status,IERR)
2830 c write (iout,*) "Gather ROTAT_OLD"
2832 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2833 & MPI_PRECOMP11(lensend),inext,5500+isend,
2834 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2835 & iprev,5500+irecv,FG_COMM,status,IERR)
2836 c write (iout,*) "Gather PRECOMP11"
2838 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2839 & MPI_PRECOMP12(lensend),inext,6600+isend,
2840 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2841 & iprev,6600+irecv,FG_COMM,status,IERR)
2842 c write (iout,*) "Gather PRECOMP12"
2844 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2846 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2847 & MPI_ROTAT2(lensend),inext,7700+isend,
2848 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2849 & iprev,7700+irecv,FG_COMM,status,IERR)
2850 c write (iout,*) "Gather PRECOMP21"
2852 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2853 & MPI_PRECOMP22(lensend),inext,8800+isend,
2854 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2855 & iprev,8800+irecv,FG_COMM,status,IERR)
2856 c write (iout,*) "Gather PRECOMP22"
2858 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2859 & MPI_PRECOMP23(lensend),inext,9900+isend,
2860 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2861 & MPI_PRECOMP23(lenrecv),
2862 & iprev,9900+irecv,FG_COMM,status,IERR)
2863 c write (iout,*) "Gather PRECOMP23"
2868 if (irecv.lt.0) irecv=nfgtasks1-1
2871 time_gather=time_gather+MPI_Wtime()-time00
2874 c if (fg_rank.eq.0) then
2875 write (iout,*) "Arrays UG and UGDER"
2877 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2878 & ((ug(l,k,i),l=1,2),k=1,2),
2879 & ((ugder(l,k,i),l=1,2),k=1,2)
2881 write (iout,*) "Arrays UG2 and UG2DER"
2883 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2884 & ((ug2(l,k,i),l=1,2),k=1,2),
2885 & ((ug2der(l,k,i),l=1,2),k=1,2)
2887 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2889 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2890 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2891 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2893 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2895 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2896 & costab(i),sintab(i),costab2(i),sintab2(i)
2898 write (iout,*) "Array MUDER"
2900 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2906 cd iti = itortyp(itype(i))
2909 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2910 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2915 C--------------------------------------------------------------------------
2916 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2918 C This subroutine calculates the average interaction energy and its gradient
2919 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2920 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2921 C The potential depends both on the distance of peptide-group centers and on
2922 C the orientation of the CA-CA virtual bonds.
2924 implicit real*8 (a-h,o-z)
2928 include 'DIMENSIONS'
2929 include 'COMMON.CONTROL'
2930 include 'COMMON.SETUP'
2931 include 'COMMON.IOUNITS'
2932 include 'COMMON.GEO'
2933 include 'COMMON.VAR'
2934 include 'COMMON.LOCAL'
2935 include 'COMMON.CHAIN'
2936 include 'COMMON.DERIV'
2937 include 'COMMON.INTERACT'
2938 include 'COMMON.CONTACTS'
2939 include 'COMMON.TORSION'
2940 include 'COMMON.VECTORS'
2941 include 'COMMON.FFIELD'
2942 include 'COMMON.TIME1'
2943 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2944 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2945 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2946 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2947 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2948 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2950 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2952 double precision scal_el /1.0d0/
2954 double precision scal_el /0.5d0/
2957 C 13-go grudnia roku pamietnego...
2958 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2959 & 0.0d0,1.0d0,0.0d0,
2960 & 0.0d0,0.0d0,1.0d0/
2961 cd write(iout,*) 'In EELEC'
2963 cd write(iout,*) 'Type',i
2964 cd write(iout,*) 'B1',B1(:,i)
2965 cd write(iout,*) 'B2',B2(:,i)
2966 cd write(iout,*) 'CC',CC(:,:,i)
2967 cd write(iout,*) 'DD',DD(:,:,i)
2968 cd write(iout,*) 'EE',EE(:,:,i)
2970 cd call check_vecgrad
2972 if (icheckgrad.eq.1) then
2974 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2976 dc_norm(k,i)=dc(k,i)*fac
2978 c write (iout,*) 'i',i,' fac',fac
2981 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2982 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2983 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2984 c call vec_and_deriv
2990 time_mat=time_mat+MPI_Wtime()-time01
2994 cd write (iout,*) 'i=',i
2996 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2999 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3000 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3013 cd print '(a)','Enter EELEC'
3014 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3016 gel_loc_loc(i)=0.0d0
3021 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3023 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3025 do i=iturn3_start,iturn3_end
3029 dx_normi=dc_norm(1,i)
3030 dy_normi=dc_norm(2,i)
3031 dz_normi=dc_norm(3,i)
3032 xmedi=c(1,i)+0.5d0*dxi
3033 ymedi=c(2,i)+0.5d0*dyi
3034 zmedi=c(3,i)+0.5d0*dzi
3036 call eelecij(i,i+2,ees,evdw1,eel_loc)
3037 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3038 num_cont_hb(i)=num_conti
3040 do i=iturn4_start,iturn4_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
3050 num_conti=num_cont_hb(i)
3051 call eelecij(i,i+3,ees,evdw1,eel_loc)
3052 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3053 num_cont_hb(i)=num_conti
3056 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3058 do i=iatel_s,iatel_e
3062 dx_normi=dc_norm(1,i)
3063 dy_normi=dc_norm(2,i)
3064 dz_normi=dc_norm(3,i)
3065 xmedi=c(1,i)+0.5d0*dxi
3066 ymedi=c(2,i)+0.5d0*dyi
3067 zmedi=c(3,i)+0.5d0*dzi
3068 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3069 num_conti=num_cont_hb(i)
3070 do j=ielstart(i),ielend(i)
3071 call eelecij(i,j,ees,evdw1,eel_loc)
3073 num_cont_hb(i)=num_conti
3075 c write (iout,*) "Number of loop steps in EELEC:",ind
3077 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3078 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3080 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3081 ccc eel_loc=eel_loc+eello_turn3
3082 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3085 C-------------------------------------------------------------------------------
3086 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3087 implicit real*8 (a-h,o-z)
3088 include 'DIMENSIONS'
3092 include 'COMMON.CONTROL'
3093 include 'COMMON.IOUNITS'
3094 include 'COMMON.GEO'
3095 include 'COMMON.VAR'
3096 include 'COMMON.LOCAL'
3097 include 'COMMON.CHAIN'
3098 include 'COMMON.DERIV'
3099 include 'COMMON.INTERACT'
3100 include 'COMMON.CONTACTS'
3101 include 'COMMON.TORSION'
3102 include 'COMMON.VECTORS'
3103 include 'COMMON.FFIELD'
3104 include 'COMMON.TIME1'
3105 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3106 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3107 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3108 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3109 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3110 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3112 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3114 double precision scal_el /1.0d0/
3116 double precision scal_el /0.5d0/
3119 C 13-go grudnia roku pamietnego...
3120 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3121 & 0.0d0,1.0d0,0.0d0,
3122 & 0.0d0,0.0d0,1.0d0/
3123 c time00=MPI_Wtime()
3124 cd write (iout,*) "eelecij",i,j
3128 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3129 aaa=app(iteli,itelj)
3130 bbb=bpp(iteli,itelj)
3131 ael6i=ael6(iteli,itelj)
3132 ael3i=ael3(iteli,itelj)
3136 dx_normj=dc_norm(1,j)
3137 dy_normj=dc_norm(2,j)
3138 dz_normj=dc_norm(3,j)
3139 xj=c(1,j)+0.5D0*dxj-xmedi
3140 yj=c(2,j)+0.5D0*dyj-ymedi
3141 zj=c(3,j)+0.5D0*dzj-zmedi
3142 rij=xj*xj+yj*yj+zj*zj
3148 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3149 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3150 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3151 fac=cosa-3.0D0*cosb*cosg
3153 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3154 if (j.eq.i+2) ev1=scal_el*ev1
3159 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3162 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3163 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3166 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3167 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3168 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3169 cd & xmedi,ymedi,zmedi,xj,yj,zj
3171 if (energy_dec) then
3172 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3173 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3177 C Calculate contributions to the Cartesian gradient.
3180 facvdw=-6*rrmij*(ev1+evdwij)
3181 facel=-3*rrmij*(el1+eesij)
3187 * Radial derivatives. First process both termini of the fragment (i,j)
3193 c ghalf=0.5D0*ggg(k)
3194 c gelc(k,i)=gelc(k,i)+ghalf
3195 c gelc(k,j)=gelc(k,j)+ghalf
3197 c 9/28/08 AL Gradient compotents will be summed only at the end
3199 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3200 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3203 * Loop over residues i+1 thru j-1.
3207 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3214 c ghalf=0.5D0*ggg(k)
3215 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3216 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3218 c 9/28/08 AL Gradient compotents will be summed only at the end
3220 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3221 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3224 * Loop over residues i+1 thru j-1.
3228 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3235 fac=-3*rrmij*(facvdw+facvdw+facel)
3240 * Radial derivatives. First process both termini of the fragment (i,j)
3246 c ghalf=0.5D0*ggg(k)
3247 c gelc(k,i)=gelc(k,i)+ghalf
3248 c gelc(k,j)=gelc(k,j)+ghalf
3250 c 9/28/08 AL Gradient compotents will be summed only at the end
3252 gelc_long(k,j)=gelc(k,j)+ggg(k)
3253 gelc_long(k,i)=gelc(k,i)-ggg(k)
3256 * Loop over residues i+1 thru j-1.
3260 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3263 c 9/28/08 AL Gradient compotents will be summed only at the end
3268 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3269 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3275 ecosa=2.0D0*fac3*fac1+fac4
3278 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3279 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3281 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3282 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3284 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3285 cd & (dcosg(k),k=1,3)
3287 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3290 c ghalf=0.5D0*ggg(k)
3291 c gelc(k,i)=gelc(k,i)+ghalf
3292 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3293 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3294 c gelc(k,j)=gelc(k,j)+ghalf
3295 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3296 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3300 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3305 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3306 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3308 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3309 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3310 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3311 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3313 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3314 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3315 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3317 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3318 C energy of a peptide unit is assumed in the form of a second-order
3319 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3320 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3321 C are computed for EVERY pair of non-contiguous peptide groups.
3323 if (j.lt.nres-1) then
3334 muij(kkk)=mu(k,i)*mu(l,j)
3337 cd write (iout,*) 'EELEC: i',i,' j',j
3338 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3339 cd write(iout,*) 'muij',muij
3340 ury=scalar(uy(1,i),erij)
3341 urz=scalar(uz(1,i),erij)
3342 vry=scalar(uy(1,j),erij)
3343 vrz=scalar(uz(1,j),erij)
3344 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3345 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3346 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3347 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3348 fac=dsqrt(-ael6i)*r3ij
3353 cd write (iout,'(4i5,4f10.5)')
3354 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3355 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3356 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3357 cd & uy(:,j),uz(:,j)
3358 cd write (iout,'(4f10.5)')
3359 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3360 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3361 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3362 cd write (iout,'(9f10.5/)')
3363 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3364 C Derivatives of the elements of A in virtual-bond vectors
3365 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3367 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3368 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3369 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3370 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3371 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3372 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3373 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3374 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3375 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3376 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3377 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3378 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3380 C Compute radial contributions to the gradient
3398 C Add the contributions coming from er
3401 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3402 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3403 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3404 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3407 C Derivatives in DC(i)
3408 cgrad ghalf1=0.5d0*agg(k,1)
3409 cgrad ghalf2=0.5d0*agg(k,2)
3410 cgrad ghalf3=0.5d0*agg(k,3)
3411 cgrad ghalf4=0.5d0*agg(k,4)
3412 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3413 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3414 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3415 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3416 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3417 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3418 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3419 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3420 C Derivatives in DC(i+1)
3421 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3422 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3423 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3424 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3425 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3426 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3427 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3428 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3429 C Derivatives in DC(j)
3430 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3431 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3432 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3433 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3434 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3435 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3436 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3437 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3438 C Derivatives in DC(j+1) or DC(nres-1)
3439 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3440 & -3.0d0*vryg(k,3)*ury)
3441 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3442 & -3.0d0*vrzg(k,3)*ury)
3443 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3444 & -3.0d0*vryg(k,3)*urz)
3445 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3446 & -3.0d0*vrzg(k,3)*urz)
3447 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3449 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3462 aggi(k,l)=-aggi(k,l)
3463 aggi1(k,l)=-aggi1(k,l)
3464 aggj(k,l)=-aggj(k,l)
3465 aggj1(k,l)=-aggj1(k,l)
3468 if (j.lt.nres-1) then
3474 aggi(k,l)=-aggi(k,l)
3475 aggi1(k,l)=-aggi1(k,l)
3476 aggj(k,l)=-aggj(k,l)
3477 aggj1(k,l)=-aggj1(k,l)
3488 aggi(k,l)=-aggi(k,l)
3489 aggi1(k,l)=-aggi1(k,l)
3490 aggj(k,l)=-aggj(k,l)
3491 aggj1(k,l)=-aggj1(k,l)
3496 IF (wel_loc.gt.0.0d0) THEN
3497 C Contribution to the local-electrostatic energy coming from the i-j pair
3498 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3500 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3502 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3503 & 'eelloc',i,j,eel_loc_ij
3505 eel_loc=eel_loc+eel_loc_ij
3506 C Partial derivatives in virtual-bond dihedral angles gamma
3508 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3509 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3510 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3511 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3512 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3513 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3514 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3516 ggg(l)=agg(l,1)*muij(1)+
3517 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3518 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3519 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3520 cgrad ghalf=0.5d0*ggg(l)
3521 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3522 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3526 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3529 C Remaining derivatives of eello
3531 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3532 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3533 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3534 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3535 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3536 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3537 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3538 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3541 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3542 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3543 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3544 & .and. num_conti.le.maxconts) then
3545 c write (iout,*) i,j," entered corr"
3547 C Calculate the contact function. The ith column of the array JCONT will
3548 C contain the numbers of atoms that make contacts with the atom I (of numbers
3549 C greater than I). The arrays FACONT and GACONT will contain the values of
3550 C the contact function and its derivative.
3551 c r0ij=1.02D0*rpp(iteli,itelj)
3552 c r0ij=1.11D0*rpp(iteli,itelj)
3553 r0ij=2.20D0*rpp(iteli,itelj)
3554 c r0ij=1.55D0*rpp(iteli,itelj)
3555 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3556 if (fcont.gt.0.0D0) then
3557 num_conti=num_conti+1
3558 if (num_conti.gt.maxconts) then
3559 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3560 & ' will skip next contacts for this conf.'
3562 jcont_hb(num_conti,i)=j
3563 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3564 cd & " jcont_hb",jcont_hb(num_conti,i)
3565 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3566 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3567 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3569 d_cont(num_conti,i)=rij
3570 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3571 C --- Electrostatic-interaction matrix ---
3572 a_chuj(1,1,num_conti,i)=a22
3573 a_chuj(1,2,num_conti,i)=a23
3574 a_chuj(2,1,num_conti,i)=a32
3575 a_chuj(2,2,num_conti,i)=a33
3576 C --- Gradient of rij
3578 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3585 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3586 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3587 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3588 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3589 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3594 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3595 C Calculate contact energies
3597 wij=cosa-3.0D0*cosb*cosg
3600 c fac3=dsqrt(-ael6i)/r0ij**3
3601 fac3=dsqrt(-ael6i)*r3ij
3602 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3603 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3604 if (ees0tmp.gt.0) then
3605 ees0pij=dsqrt(ees0tmp)
3609 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3610 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3611 if (ees0tmp.gt.0) then
3612 ees0mij=dsqrt(ees0tmp)
3617 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3618 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3619 C Diagnostics. Comment out or remove after debugging!
3620 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3621 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3622 c ees0m(num_conti,i)=0.0D0
3624 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3625 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3626 C Angular derivatives of the contact function
3627 ees0pij1=fac3/ees0pij
3628 ees0mij1=fac3/ees0mij
3629 fac3p=-3.0D0*fac3*rrmij
3630 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3631 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3633 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3634 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3635 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3636 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3637 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3638 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3639 ecosap=ecosa1+ecosa2
3640 ecosbp=ecosb1+ecosb2
3641 ecosgp=ecosg1+ecosg2
3642 ecosam=ecosa1-ecosa2
3643 ecosbm=ecosb1-ecosb2
3644 ecosgm=ecosg1-ecosg2
3653 facont_hb(num_conti,i)=fcont
3654 fprimcont=fprimcont/rij
3655 cd facont_hb(num_conti,i)=1.0D0
3656 C Following line is for diagnostics.
3659 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3660 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3663 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3664 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3666 gggp(1)=gggp(1)+ees0pijp*xj
3667 gggp(2)=gggp(2)+ees0pijp*yj
3668 gggp(3)=gggp(3)+ees0pijp*zj
3669 gggm(1)=gggm(1)+ees0mijp*xj
3670 gggm(2)=gggm(2)+ees0mijp*yj
3671 gggm(3)=gggm(3)+ees0mijp*zj
3672 C Derivatives due to the contact function
3673 gacont_hbr(1,num_conti,i)=fprimcont*xj
3674 gacont_hbr(2,num_conti,i)=fprimcont*yj
3675 gacont_hbr(3,num_conti,i)=fprimcont*zj
3678 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3679 c following the change of gradient-summation algorithm.
3681 cgrad ghalfp=0.5D0*gggp(k)
3682 cgrad ghalfm=0.5D0*gggm(k)
3683 gacontp_hb1(k,num_conti,i)=!ghalfp
3684 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3685 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3686 gacontp_hb2(k,num_conti,i)=!ghalfp
3687 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3688 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3689 gacontp_hb3(k,num_conti,i)=gggp(k)
3690 gacontm_hb1(k,num_conti,i)=!ghalfm
3691 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3692 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3693 gacontm_hb2(k,num_conti,i)=!ghalfm
3694 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3695 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3696 gacontm_hb3(k,num_conti,i)=gggm(k)
3698 C Diagnostics. Comment out or remove after debugging!
3700 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3701 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3702 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3703 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3704 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3705 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3708 endif ! num_conti.le.maxconts
3711 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3714 ghalf=0.5d0*agg(l,k)
3715 aggi(l,k)=aggi(l,k)+ghalf
3716 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3717 aggj(l,k)=aggj(l,k)+ghalf
3720 if (j.eq.nres-1 .and. i.lt.j-2) then
3723 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3728 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3731 C-----------------------------------------------------------------------------
3732 subroutine eturn3(i,eello_turn3)
3733 C Third- and fourth-order contributions from turns
3734 implicit real*8 (a-h,o-z)
3735 include 'DIMENSIONS'
3736 include 'COMMON.IOUNITS'
3737 include 'COMMON.GEO'
3738 include 'COMMON.VAR'
3739 include 'COMMON.LOCAL'
3740 include 'COMMON.CHAIN'
3741 include 'COMMON.DERIV'
3742 include 'COMMON.INTERACT'
3743 include 'COMMON.CONTACTS'
3744 include 'COMMON.TORSION'
3745 include 'COMMON.VECTORS'
3746 include 'COMMON.FFIELD'
3747 include 'COMMON.CONTROL'
3749 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3750 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3751 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3752 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3753 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3754 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3755 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3758 c write (iout,*) "eturn3",i,j,j1,j2
3763 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3765 C Third-order contributions
3772 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3773 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3774 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3775 call transpose2(auxmat(1,1),auxmat1(1,1))
3776 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3777 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3778 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3779 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3780 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3781 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3782 cd & ' eello_turn3_num',4*eello_turn3_num
3783 C Derivatives in gamma(i)
3784 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3785 call transpose2(auxmat2(1,1),auxmat3(1,1))
3786 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3787 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3788 C Derivatives in gamma(i+1)
3789 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3790 call transpose2(auxmat2(1,1),auxmat3(1,1))
3791 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3792 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3793 & +0.5d0*(pizda(1,1)+pizda(2,2))
3794 C Cartesian derivatives
3796 c ghalf1=0.5d0*agg(l,1)
3797 c ghalf2=0.5d0*agg(l,2)
3798 c ghalf3=0.5d0*agg(l,3)
3799 c ghalf4=0.5d0*agg(l,4)
3800 a_temp(1,1)=aggi(l,1)!+ghalf1
3801 a_temp(1,2)=aggi(l,2)!+ghalf2
3802 a_temp(2,1)=aggi(l,3)!+ghalf3
3803 a_temp(2,2)=aggi(l,4)!+ghalf4
3804 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3805 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3806 & +0.5d0*(pizda(1,1)+pizda(2,2))
3807 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3808 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3809 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3810 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3811 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3812 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3813 & +0.5d0*(pizda(1,1)+pizda(2,2))
3814 a_temp(1,1)=aggj(l,1)!+ghalf1
3815 a_temp(1,2)=aggj(l,2)!+ghalf2
3816 a_temp(2,1)=aggj(l,3)!+ghalf3
3817 a_temp(2,2)=aggj(l,4)!+ghalf4
3818 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3819 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3820 & +0.5d0*(pizda(1,1)+pizda(2,2))
3821 a_temp(1,1)=aggj1(l,1)
3822 a_temp(1,2)=aggj1(l,2)
3823 a_temp(2,1)=aggj1(l,3)
3824 a_temp(2,2)=aggj1(l,4)
3825 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3826 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3827 & +0.5d0*(pizda(1,1)+pizda(2,2))
3831 C-------------------------------------------------------------------------------
3832 subroutine eturn4(i,eello_turn4)
3833 C Third- and fourth-order contributions from turns
3834 implicit real*8 (a-h,o-z)
3835 include 'DIMENSIONS'
3836 include 'COMMON.IOUNITS'
3837 include 'COMMON.GEO'
3838 include 'COMMON.VAR'
3839 include 'COMMON.LOCAL'
3840 include 'COMMON.CHAIN'
3841 include 'COMMON.DERIV'
3842 include 'COMMON.INTERACT'
3843 include 'COMMON.CONTACTS'
3844 include 'COMMON.TORSION'
3845 include 'COMMON.VECTORS'
3846 include 'COMMON.FFIELD'
3847 include 'COMMON.CONTROL'
3849 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3850 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3851 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3852 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3853 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3854 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3855 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3858 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3860 C Fourth-order contributions
3868 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3869 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3870 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3875 iti1=itortyp(itype(i+1))
3876 iti2=itortyp(itype(i+2))
3877 iti3=itortyp(itype(i+3))
3878 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3879 call transpose2(EUg(1,1,i+1),e1t(1,1))
3880 call transpose2(Eug(1,1,i+2),e2t(1,1))
3881 call transpose2(Eug(1,1,i+3),e3t(1,1))
3882 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3883 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3884 s1=scalar2(b1(1,iti2),auxvec(1))
3885 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3886 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3887 s2=scalar2(b1(1,iti1),auxvec(1))
3888 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3889 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3890 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3891 eello_turn4=eello_turn4-(s1+s2+s3)
3892 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3893 & 'eturn4',i,j,-(s1+s2+s3)
3894 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3895 cd & ' eello_turn4_num',8*eello_turn4_num
3896 C Derivatives in gamma(i)
3897 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3898 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3899 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3900 s1=scalar2(b1(1,iti2),auxvec(1))
3901 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3902 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3903 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3904 C Derivatives in gamma(i+1)
3905 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3906 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3907 s2=scalar2(b1(1,iti1),auxvec(1))
3908 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3909 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3910 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3911 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3912 C Derivatives in gamma(i+2)
3913 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3914 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,iti2),auxvec(1))
3916 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3917 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3918 s2=scalar2(b1(1,iti1),auxvec(1))
3919 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3920 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3921 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3922 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3923 C Cartesian derivatives
3924 C Derivatives of this turn contributions in DC(i+2)
3925 if (j.lt.nres-1) then
3927 a_temp(1,1)=agg(l,1)
3928 a_temp(1,2)=agg(l,2)
3929 a_temp(2,1)=agg(l,3)
3930 a_temp(2,2)=agg(l,4)
3931 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3932 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3933 s1=scalar2(b1(1,iti2),auxvec(1))
3934 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3935 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3936 s2=scalar2(b1(1,iti1),auxvec(1))
3937 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3938 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3939 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3941 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3944 C Remaining derivatives of this turn contribution
3946 a_temp(1,1)=aggi(l,1)
3947 a_temp(1,2)=aggi(l,2)
3948 a_temp(2,1)=aggi(l,3)
3949 a_temp(2,2)=aggi(l,4)
3950 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3951 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3952 s1=scalar2(b1(1,iti2),auxvec(1))
3953 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3954 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3955 s2=scalar2(b1(1,iti1),auxvec(1))
3956 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3957 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3958 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3959 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3960 a_temp(1,1)=aggi1(l,1)
3961 a_temp(1,2)=aggi1(l,2)
3962 a_temp(2,1)=aggi1(l,3)
3963 a_temp(2,2)=aggi1(l,4)
3964 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3965 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3966 s1=scalar2(b1(1,iti2),auxvec(1))
3967 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3968 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3969 s2=scalar2(b1(1,iti1),auxvec(1))
3970 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3971 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3972 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3973 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3974 a_temp(1,1)=aggj(l,1)
3975 a_temp(1,2)=aggj(l,2)
3976 a_temp(2,1)=aggj(l,3)
3977 a_temp(2,2)=aggj(l,4)
3978 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3979 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3980 s1=scalar2(b1(1,iti2),auxvec(1))
3981 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3982 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3983 s2=scalar2(b1(1,iti1),auxvec(1))
3984 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3985 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3986 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3987 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3988 a_temp(1,1)=aggj1(l,1)
3989 a_temp(1,2)=aggj1(l,2)
3990 a_temp(2,1)=aggj1(l,3)
3991 a_temp(2,2)=aggj1(l,4)
3992 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3993 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3994 s1=scalar2(b1(1,iti2),auxvec(1))
3995 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3996 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3997 s2=scalar2(b1(1,iti1),auxvec(1))
3998 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3999 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4000 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4001 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4002 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4006 C-----------------------------------------------------------------------------
4007 subroutine vecpr(u,v,w)
4008 implicit real*8(a-h,o-z)
4009 dimension u(3),v(3),w(3)
4010 w(1)=u(2)*v(3)-u(3)*v(2)
4011 w(2)=-u(1)*v(3)+u(3)*v(1)
4012 w(3)=u(1)*v(2)-u(2)*v(1)
4015 C-----------------------------------------------------------------------------
4016 subroutine unormderiv(u,ugrad,unorm,ungrad)
4017 C This subroutine computes the derivatives of a normalized vector u, given
4018 C the derivatives computed without normalization conditions, ugrad. Returns
4021 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4022 double precision vec(3)
4023 double precision scalar
4025 c write (2,*) 'ugrad',ugrad
4028 vec(i)=scalar(ugrad(1,i),u(1))
4030 c write (2,*) 'vec',vec
4033 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4036 c write (2,*) 'ungrad',ungrad
4039 C-----------------------------------------------------------------------------
4040 subroutine escp_soft_sphere(evdw2,evdw2_14)
4042 C This subroutine calculates the excluded-volume interaction energy between
4043 C peptide-group centers and side chains and its gradient in virtual-bond and
4044 C side-chain vectors.
4046 implicit real*8 (a-h,o-z)
4047 include 'DIMENSIONS'
4048 include 'COMMON.GEO'
4049 include 'COMMON.VAR'
4050 include 'COMMON.LOCAL'
4051 include 'COMMON.CHAIN'
4052 include 'COMMON.DERIV'
4053 include 'COMMON.INTERACT'
4054 include 'COMMON.FFIELD'
4055 include 'COMMON.IOUNITS'
4056 include 'COMMON.CONTROL'
4061 cd print '(a)','Enter ESCP'
4062 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4063 do i=iatscp_s,iatscp_e
4065 xi=0.5D0*(c(1,i)+c(1,i+1))
4066 yi=0.5D0*(c(2,i)+c(2,i+1))
4067 zi=0.5D0*(c(3,i)+c(3,i+1))
4069 do iint=1,nscp_gr(i)
4071 do j=iscpstart(i,iint),iscpend(i,iint)
4073 C Uncomment following three lines for SC-p interactions
4077 C Uncomment following three lines for Ca-p interactions
4081 rij=xj*xj+yj*yj+zj*zj
4084 if (rij.lt.r0ijsq) then
4085 evdwij=0.25d0*(rij-r0ijsq)**2
4093 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4098 cgrad if (j.lt.i) then
4099 cd write (iout,*) 'j<i'
4100 C Uncomment following three lines for SC-p interactions
4102 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4105 cd write (iout,*) 'j>i'
4107 cgrad ggg(k)=-ggg(k)
4108 C Uncomment following line for SC-p interactions
4109 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4113 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4115 cgrad kstart=min0(i+1,j)
4116 cgrad kend=max0(i-1,j-1)
4117 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4118 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4119 cgrad do k=kstart,kend
4121 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4125 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4126 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4134 C-----------------------------------------------------------------------------
4135 subroutine escp(evdw2,evdw2_14)
4137 C This subroutine calculates the excluded-volume interaction energy between
4138 C peptide-group centers and side chains and its gradient in virtual-bond and
4139 C side-chain vectors.
4141 implicit real*8 (a-h,o-z)
4142 include 'DIMENSIONS'
4143 include 'COMMON.GEO'
4144 include 'COMMON.VAR'
4145 include 'COMMON.LOCAL'
4146 include 'COMMON.CHAIN'
4147 include 'COMMON.DERIV'
4148 include 'COMMON.INTERACT'
4149 include 'COMMON.FFIELD'
4150 include 'COMMON.IOUNITS'
4151 include 'COMMON.CONTROL'
4155 cd print '(a)','Enter ESCP'
4156 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4157 do i=iatscp_s,iatscp_e
4159 xi=0.5D0*(c(1,i)+c(1,i+1))
4160 yi=0.5D0*(c(2,i)+c(2,i+1))
4161 zi=0.5D0*(c(3,i)+c(3,i+1))
4163 do iint=1,nscp_gr(i)
4165 do j=iscpstart(i,iint),iscpend(i,iint)
4167 C Uncomment following three lines for SC-p interactions
4171 C Uncomment following three lines for Ca-p interactions
4175 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4177 e1=fac*fac*aad(itypj,iteli)
4178 e2=fac*bad(itypj,iteli)
4179 if (iabs(j-i) .le. 2) then
4182 evdw2_14=evdw2_14+e1+e2
4186 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4187 & 'evdw2',i,j,evdwij
4189 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4191 fac=-(evdwij+e1)*rrij
4195 cgrad if (j.lt.i) then
4196 cd write (iout,*) 'j<i'
4197 C Uncomment following three lines for SC-p interactions
4199 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4202 cd write (iout,*) 'j>i'
4204 cgrad ggg(k)=-ggg(k)
4205 C Uncomment following line for SC-p interactions
4206 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4207 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4211 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4213 cgrad kstart=min0(i+1,j)
4214 cgrad kend=max0(i-1,j-1)
4215 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4216 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4217 cgrad do k=kstart,kend
4219 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4223 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4224 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4232 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4233 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4234 gradx_scp(j,i)=expon*gradx_scp(j,i)
4237 C******************************************************************************
4241 C To save time the factor EXPON has been extracted from ALL components
4242 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4245 C******************************************************************************
4248 C--------------------------------------------------------------------------
4249 subroutine edis(ehpb)
4251 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4253 implicit real*8 (a-h,o-z)
4254 include 'DIMENSIONS'
4255 include 'COMMON.SBRIDGE'
4256 include 'COMMON.CHAIN'
4257 include 'COMMON.DERIV'
4258 include 'COMMON.VAR'
4259 include 'COMMON.INTERACT'
4260 include 'COMMON.IOUNITS'
4263 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4264 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4265 if (link_end.eq.0) return
4266 do i=link_start,link_end
4267 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4268 C CA-CA distance used in regularization of structure.
4271 C iii and jjj point to the residues for which the distance is assigned.
4272 if (ii.gt.nres) then
4279 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4280 c & dhpb(i),dhpb1(i),forcon(i)
4281 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4282 C distance and angle dependent SS bond potential.
4283 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4284 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4285 if (.not.dyn_ss .and. i.le.nss) then
4286 C 15/02/13 CC dynamic SSbond - additional check
4288 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4289 call ssbond_ene(iii,jjj,eij)
4292 cd write (iout,*) "eij",eij
4293 else if (ii.gt.nres .and. jj.gt.nres) then
4294 c Restraints from contact prediction
4296 if (dhpb1(i).gt.0.0d0) then
4297 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4298 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4299 c write (iout,*) "beta nmr",
4300 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4304 C Get the force constant corresponding to this distance.
4306 C Calculate the contribution to energy.
4307 ehpb=ehpb+waga*rdis*rdis
4308 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4310 C Evaluate gradient.
4315 ggg(j)=fac*(c(j,jj)-c(j,ii))
4318 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4319 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4322 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4323 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4326 C Calculate the distance between the two points and its difference from the
4329 if (dhpb1(i).gt.0.0d0) then
4330 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4331 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4332 c write (iout,*) "alph nmr",
4333 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4336 C Get the force constant corresponding to this distance.
4338 C Calculate the contribution to energy.
4339 ehpb=ehpb+waga*rdis*rdis
4340 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4342 C Evaluate gradient.
4346 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4347 cd & ' waga=',waga,' fac=',fac
4349 ggg(j)=fac*(c(j,jj)-c(j,ii))
4351 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4352 C If this is a SC-SC distance, we need to calculate the contributions to the
4353 C Cartesian gradient in the SC vectors (ghpbx).
4356 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4357 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4360 cgrad do j=iii,jjj-1
4362 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4366 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4367 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4374 C--------------------------------------------------------------------------
4375 subroutine ssbond_ene(i,j,eij)
4377 C Calculate the distance and angle dependent SS-bond potential energy
4378 C using a free-energy function derived based on RHF/6-31G** ab initio
4379 C calculations of diethyl disulfide.
4381 C A. Liwo and U. Kozlowska, 11/24/03
4383 implicit real*8 (a-h,o-z)
4384 include 'DIMENSIONS'
4385 include 'COMMON.SBRIDGE'
4386 include 'COMMON.CHAIN'
4387 include 'COMMON.DERIV'
4388 include 'COMMON.LOCAL'
4389 include 'COMMON.INTERACT'
4390 include 'COMMON.VAR'
4391 include 'COMMON.IOUNITS'
4392 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4397 dxi=dc_norm(1,nres+i)
4398 dyi=dc_norm(2,nres+i)
4399 dzi=dc_norm(3,nres+i)
4400 c dsci_inv=dsc_inv(itypi)
4401 dsci_inv=vbld_inv(nres+i)
4403 c dscj_inv=dsc_inv(itypj)
4404 dscj_inv=vbld_inv(nres+j)
4408 dxj=dc_norm(1,nres+j)
4409 dyj=dc_norm(2,nres+j)
4410 dzj=dc_norm(3,nres+j)
4411 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4416 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4417 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4418 om12=dxi*dxj+dyi*dyj+dzi*dzj
4420 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4421 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4427 deltat12=om2-om1+2.0d0
4429 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4430 & +akct*deltad*deltat12+ebr
4431 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4432 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4433 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4434 c & " deltat12",deltat12," eij",eij
4435 ed=2*akcm*deltad+akct*deltat12
4437 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4438 eom1=-2*akth*deltat1-pom1-om2*pom2
4439 eom2= 2*akth*deltat2+pom1-om1*pom2
4442 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4443 ghpbx(k,i)=ghpbx(k,i)-ggk
4444 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4445 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4446 ghpbx(k,j)=ghpbx(k,j)+ggk
4447 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4448 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4449 ghpbc(k,i)=ghpbc(k,i)-ggk
4450 ghpbc(k,j)=ghpbc(k,j)+ggk
4453 C Calculate the components of the gradient in DC and X
4457 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4462 C--------------------------------------------------------------------------
4463 subroutine ebond(estr)
4465 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4467 implicit real*8 (a-h,o-z)
4468 include 'DIMENSIONS'
4469 include 'COMMON.LOCAL'
4470 include 'COMMON.GEO'
4471 include 'COMMON.INTERACT'
4472 include 'COMMON.DERIV'
4473 include 'COMMON.VAR'
4474 include 'COMMON.CHAIN'
4475 include 'COMMON.IOUNITS'
4476 include 'COMMON.NAMES'
4477 include 'COMMON.FFIELD'
4478 include 'COMMON.CONTROL'
4479 include 'COMMON.SETUP'
4480 double precision u(3),ud(3)
4482 do i=ibondp_start,ibondp_end
4483 diff = vbld(i)-vbldp0
4484 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4487 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4489 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4493 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4495 do i=ibond_start,ibond_end
4500 diff=vbld(i+nres)-vbldsc0(1,iti)
4501 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4502 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4503 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4505 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4509 diff=vbld(i+nres)-vbldsc0(j,iti)
4510 ud(j)=aksc(j,iti)*diff
4511 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4525 uprod2=uprod2*u(k)*u(k)
4529 usumsqder=usumsqder+ud(j)*uprod2
4531 estr=estr+uprod/usum
4533 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4541 C--------------------------------------------------------------------------
4542 subroutine ebend(etheta)
4544 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4545 C angles gamma and its derivatives in consecutive thetas and gammas.
4547 implicit real*8 (a-h,o-z)
4548 include 'DIMENSIONS'
4549 include 'COMMON.LOCAL'
4550 include 'COMMON.GEO'
4551 include 'COMMON.INTERACT'
4552 include 'COMMON.DERIV'
4553 include 'COMMON.VAR'
4554 include 'COMMON.CHAIN'
4555 include 'COMMON.IOUNITS'
4556 include 'COMMON.NAMES'
4557 include 'COMMON.FFIELD'
4558 include 'COMMON.CONTROL'
4559 common /calcthet/ term1,term2,termm,diffak,ratak,
4560 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4561 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4562 double precision y(2),z(2)
4564 c time11=dexp(-2*time)
4567 c write (*,'(a,i2)') 'EBEND ICG=',icg
4568 do i=ithet_start,ithet_end
4569 C Zero the energy function and its derivative at 0 or pi.
4570 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4572 ichir1=isign(1,itype(i-2))
4573 ichir2=isign(1,itype(i))
4574 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4575 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4576 if (itype(i-1).eq.10) then
4577 itype1=isign(10,itype(i-2))
4578 ichir11=isign(1,itype(i-2))
4579 ichir12=isign(1,itype(i-2))
4580 itype2=isign(10,itype(i))
4581 ichir21=isign(1,itype(i))
4582 ichir22=isign(1,itype(i))
4587 if (phii.ne.phii) phii=150.0
4600 if (phii1.ne.phii1) phii1=150.0
4612 C Calculate the "mean" value of theta from the part of the distribution
4613 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4614 C In following comments this theta will be referred to as t_c.
4615 thet_pred_mean=0.0d0
4617 athetk=athet(k,it,ichir1,ichir2)
4618 bthetk=bthet(k,it,ichir1,ichir2)
4620 athetk=athet(k,itype1,ichir11,ichir12)
4621 bthetk=bthet(k,itype2,ichir21,ichir22)
4623 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4625 dthett=thet_pred_mean*ssd
4626 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4627 C Derivatives of the "mean" values in gamma1 and gamma2.
4628 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4629 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4630 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4631 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4633 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4634 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4635 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4636 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4638 if (theta(i).gt.pi-delta) then
4639 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4641 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4642 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4643 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4645 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4647 else if (theta(i).lt.delta) then
4648 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4649 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4650 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4652 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4653 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4656 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4659 etheta=etheta+ethetai
4660 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4662 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4663 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4664 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4666 C Ufff.... We've done all this!!!
4669 C---------------------------------------------------------------------------
4670 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4672 implicit real*8 (a-h,o-z)
4673 include 'DIMENSIONS'
4674 include 'COMMON.LOCAL'
4675 include 'COMMON.IOUNITS'
4676 common /calcthet/ term1,term2,termm,diffak,ratak,
4677 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4678 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4679 C Calculate the contributions to both Gaussian lobes.
4680 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4681 C The "polynomial part" of the "standard deviation" of this part of
4685 sig=sig*thet_pred_mean+polthet(j,it)
4687 C Derivative of the "interior part" of the "standard deviation of the"
4688 C gamma-dependent Gaussian lobe in t_c.
4689 sigtc=3*polthet(3,it)
4691 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4694 C Set the parameters of both Gaussian lobes of the distribution.
4695 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4696 fac=sig*sig+sigc0(it)
4699 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4700 sigsqtc=-4.0D0*sigcsq*sigtc
4701 c print *,i,sig,sigtc,sigsqtc
4702 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4703 sigtc=-sigtc/(fac*fac)
4704 C Following variable is sigma(t_c)**(-2)
4705 sigcsq=sigcsq*sigcsq
4707 sig0inv=1.0D0/sig0i**2
4708 delthec=thetai-thet_pred_mean
4709 delthe0=thetai-theta0i
4710 term1=-0.5D0*sigcsq*delthec*delthec
4711 term2=-0.5D0*sig0inv*delthe0*delthe0
4712 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4713 C NaNs in taking the logarithm. We extract the largest exponent which is added
4714 C to the energy (this being the log of the distribution) at the end of energy
4715 C term evaluation for this virtual-bond angle.
4716 if (term1.gt.term2) then
4718 term2=dexp(term2-termm)
4722 term1=dexp(term1-termm)
4725 C The ratio between the gamma-independent and gamma-dependent lobes of
4726 C the distribution is a Gaussian function of thet_pred_mean too.
4727 diffak=gthet(2,it)-thet_pred_mean
4728 ratak=diffak/gthet(3,it)**2
4729 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4730 C Let's differentiate it in thet_pred_mean NOW.
4732 C Now put together the distribution terms to make complete distribution.
4733 termexp=term1+ak*term2
4734 termpre=sigc+ak*sig0i
4735 C Contribution of the bending energy from this theta is just the -log of
4736 C the sum of the contributions from the two lobes and the pre-exponential
4737 C factor. Simple enough, isn't it?
4738 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4739 C NOW the derivatives!!!
4740 C 6/6/97 Take into account the deformation.
4741 E_theta=(delthec*sigcsq*term1
4742 & +ak*delthe0*sig0inv*term2)/termexp
4743 E_tc=((sigtc+aktc*sig0i)/termpre
4744 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4745 & aktc*term2)/termexp)
4748 c-----------------------------------------------------------------------------
4749 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4750 implicit real*8 (a-h,o-z)
4751 include 'DIMENSIONS'
4752 include 'COMMON.LOCAL'
4753 include 'COMMON.IOUNITS'
4754 common /calcthet/ term1,term2,termm,diffak,ratak,
4755 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4756 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4757 delthec=thetai-thet_pred_mean
4758 delthe0=thetai-theta0i
4759 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4760 t3 = thetai-thet_pred_mean
4764 t14 = t12+t6*sigsqtc
4766 t21 = thetai-theta0i
4772 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4773 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4774 & *(-t12*t9-ak*sig0inv*t27)
4778 C--------------------------------------------------------------------------
4779 subroutine ebend(etheta)
4781 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4782 C angles gamma and its derivatives in consecutive thetas and gammas.
4783 C ab initio-derived potentials from
4784 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4786 implicit real*8 (a-h,o-z)
4787 include 'DIMENSIONS'
4788 include 'COMMON.LOCAL'
4789 include 'COMMON.GEO'
4790 include 'COMMON.INTERACT'
4791 include 'COMMON.DERIV'
4792 include 'COMMON.VAR'
4793 include 'COMMON.CHAIN'
4794 include 'COMMON.IOUNITS'
4795 include 'COMMON.NAMES'
4796 include 'COMMON.FFIELD'
4797 include 'COMMON.CONTROL'
4798 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4799 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4800 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4801 & sinph1ph2(maxdouble,maxdouble)
4802 logical lprn /.false./, lprn1 /.false./
4804 do i=ithet_start,ithet_end
4808 theti2=0.5d0*theta(i)
4809 ityp2=ithetyp(itype(i-1))
4811 coskt(k)=dcos(k*theti2)
4812 sinkt(k)=dsin(k*theti2)
4817 if (phii.ne.phii) phii=150.0
4821 ityp1=ithetyp(itype(i-2))
4823 cosph1(k)=dcos(k*phii)
4824 sinph1(k)=dsin(k*phii)
4836 if (iabs(itype(i+1)).eq.20) iblock=2
4837 if (iabs(itype(i+1)).ne.20) iblock=1
4840 if (phii1.ne.phii1) phii1=150.0
4845 ityp3=ithetyp(itype(i))
4847 cosph2(k)=dcos(k*phii1)
4848 sinph2(k)=dsin(k*phii1)
4858 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4861 ccl=cosph1(l)*cosph2(k-l)
4862 ssl=sinph1(l)*sinph2(k-l)
4863 scl=sinph1(l)*cosph2(k-l)
4864 csl=cosph1(l)*sinph2(k-l)
4865 cosph1ph2(l,k)=ccl-ssl
4866 cosph1ph2(k,l)=ccl+ssl
4867 sinph1ph2(l,k)=scl+csl
4868 sinph1ph2(k,l)=scl-csl
4872 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4873 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4874 write (iout,*) "coskt and sinkt"
4876 write (iout,*) k,coskt(k),sinkt(k)
4880 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4881 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4884 & write (iout,*) "k",k,
4885 & "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4886 & " ethetai",ethetai
4889 write (iout,*) "cosph and sinph"
4891 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4893 write (iout,*) "cosph1ph2 and sinph2ph2"
4896 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4897 & sinph1ph2(l,k),sinph1ph2(k,l)
4900 write(iout,*) "ethetai",ethetai
4904 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4905 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4906 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4907 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4908 ethetai=ethetai+sinkt(m)*aux
4909 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4910 dephii=dephii+k*sinkt(m)*(
4911 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4912 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4913 dephii1=dephii1+k*sinkt(m)*(
4914 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4915 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4917 & write (iout,*) "m",m," k",k," bbthet",
4918 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4919 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4920 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4921 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4925 & write(iout,*) "ethetai",ethetai
4929 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4930 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4931 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4932 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4934 ethetai=ethetai+sinkt(m)*aux
4935 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4936 dephii=dephii+l*sinkt(m)*(
4937 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4938 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4939 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4940 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4942 dephii1=dephii1+(k-l)*sinkt(m)*(
4943 &-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4944 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4945 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4946 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4949 write (iout,*) "m",m," k",k," l",l," ffthet",
4950 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4951 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4952 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4953 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4954 & " ethetai",ethetai
4956 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4957 & cosph1ph2(k,l)*sinkt(m),
4958 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4965 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4966 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
4967 & phii1*rad2deg,ethetai
4969 etheta=etheta+ethetai
4970 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4971 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4972 gloc(nphi+i-2,icg)=wang*dethetai
4978 c-----------------------------------------------------------------------------
4979 subroutine esc(escloc)
4980 C Calculate the local energy of a side chain and its derivatives in the
4981 C corresponding virtual-bond valence angles THETA and the spherical angles
4983 implicit real*8 (a-h,o-z)
4984 include 'DIMENSIONS'
4985 include 'COMMON.GEO'
4986 include 'COMMON.LOCAL'
4987 include 'COMMON.VAR'
4988 include 'COMMON.INTERACT'
4989 include 'COMMON.DERIV'
4990 include 'COMMON.CHAIN'
4991 include 'COMMON.IOUNITS'
4992 include 'COMMON.NAMES'
4993 include 'COMMON.FFIELD'
4994 include 'COMMON.CONTROL'
4995 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4996 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4997 common /sccalc/ time11,time12,time112,theti,it,nlobit
5000 c write (iout,'(a)') 'ESC'
5001 do i=loc_start,loc_end
5003 if (it.eq.10) goto 1
5005 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5006 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5007 theti=theta(i+1)-pipol
5012 if (x(2).gt.pi-delta) then
5016 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5018 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5019 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5021 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5022 & ddersc0(1),dersc(1))
5023 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5024 & ddersc0(3),dersc(3))
5026 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5028 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5029 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5030 & dersc0(2),esclocbi,dersc02)
5031 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5033 call splinthet(x(2),0.5d0*delta,ss,ssd)
5038 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5040 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5041 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5043 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5045 c write (iout,*) escloci
5046 else if (x(2).lt.delta) then
5050 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5052 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5053 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5055 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5056 & ddersc0(1),dersc(1))
5057 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5058 & ddersc0(3),dersc(3))
5060 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5062 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5063 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5064 & dersc0(2),esclocbi,dersc02)
5065 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5070 call splinthet(x(2),0.5d0*delta,ss,ssd)
5072 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5074 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5075 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5077 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5078 c write (iout,*) escloci
5080 call enesc(x,escloci,dersc,ddummy,.false.)
5083 escloc=escloc+escloci
5084 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5085 & 'escloc',i,escloci
5086 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5088 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5090 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5091 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5096 C---------------------------------------------------------------------------
5097 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5098 implicit real*8 (a-h,o-z)
5099 include 'DIMENSIONS'
5100 include 'COMMON.GEO'
5101 include 'COMMON.LOCAL'
5102 include 'COMMON.IOUNITS'
5103 common /sccalc/ time11,time12,time112,theti,it,nlobit
5104 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5105 double precision contr(maxlob,-1:1)
5107 c write (iout,*) 'it=',it,' nlobit=',nlobit
5111 if (mixed) ddersc(j)=0.0d0
5115 C Because of periodicity of the dependence of the SC energy in omega we have
5116 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5117 C To avoid underflows, first compute & store the exponents.
5125 z(k)=x(k)-censc(k,j,it)
5130 Axk=Axk+gaussc(l,k,j,it)*z(l)
5136 expfac=expfac+Ax(k,j,iii)*z(k)
5144 C As in the case of ebend, we want to avoid underflows in exponentiation and
5145 C subsequent NaNs and INFs in energy calculation.
5146 C Find the largest exponent
5150 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5154 cd print *,'it=',it,' emin=',emin
5156 C Compute the contribution to SC energy and derivatives
5161 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5162 if(adexp.ne.adexp) adexp=1.0
5165 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5167 cd print *,'j=',j,' expfac=',expfac
5168 escloc_i=escloc_i+expfac
5170 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5174 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5175 & +gaussc(k,2,j,it))*expfac
5182 dersc(1)=dersc(1)/cos(theti)**2
5183 ddersc(1)=ddersc(1)/cos(theti)**2
5186 escloci=-(dlog(escloc_i)-emin)
5188 dersc(j)=dersc(j)/escloc_i
5192 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5197 C------------------------------------------------------------------------------
5198 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5199 implicit real*8 (a-h,o-z)
5200 include 'DIMENSIONS'
5201 include 'COMMON.GEO'
5202 include 'COMMON.LOCAL'
5203 include 'COMMON.IOUNITS'
5204 common /sccalc/ time11,time12,time112,theti,it,nlobit
5205 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5206 double precision contr(maxlob)
5217 z(k)=x(k)-censc(k,j,it)
5223 Axk=Axk+gaussc(l,k,j,it)*z(l)
5229 expfac=expfac+Ax(k,j)*z(k)
5234 C As in the case of ebend, we want to avoid underflows in exponentiation and
5235 C subsequent NaNs and INFs in energy calculation.
5236 C Find the largest exponent
5239 if (emin.gt.contr(j)) emin=contr(j)
5243 C Compute the contribution to SC energy and derivatives
5247 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5248 escloc_i=escloc_i+expfac
5250 dersc(k)=dersc(k)+Ax(k,j)*expfac
5252 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5253 & +gaussc(1,2,j,it))*expfac
5257 dersc(1)=dersc(1)/cos(theti)**2
5258 dersc12=dersc12/cos(theti)**2
5259 escloci=-(dlog(escloc_i)-emin)
5261 dersc(j)=dersc(j)/escloc_i
5263 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5267 c----------------------------------------------------------------------------------
5268 subroutine esc(escloc)
5269 C Calculate the local energy of a side chain and its derivatives in the
5270 C corresponding virtual-bond valence angles THETA and the spherical angles
5271 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5272 C added by Urszula Kozlowska. 07/11/2007
5274 implicit real*8 (a-h,o-z)
5275 include 'DIMENSIONS'
5276 include 'COMMON.GEO'
5277 include 'COMMON.LOCAL'
5278 include 'COMMON.VAR'
5279 include 'COMMON.SCROT'
5280 include 'COMMON.INTERACT'
5281 include 'COMMON.DERIV'
5282 include 'COMMON.CHAIN'
5283 include 'COMMON.IOUNITS'
5284 include 'COMMON.NAMES'
5285 include 'COMMON.FFIELD'
5286 include 'COMMON.CONTROL'
5287 include 'COMMON.VECTORS'
5288 double precision x_prime(3),y_prime(3),z_prime(3)
5289 & , sumene,dsc_i,dp2_i,x(65),
5290 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5291 & de_dxx,de_dyy,de_dzz,de_dt
5292 double precision s1_t,s1_6_t,s2_t,s2_6_t
5294 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5295 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5296 & dt_dCi(3),dt_dCi1(3)
5297 common /sccalc/ time11,time12,time112,theti,it,nlobit
5300 do i=loc_start,loc_end
5301 costtab(i+1) =dcos(theta(i+1))
5302 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5303 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5304 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5305 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5306 cosfac=dsqrt(cosfac2)
5307 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5308 sinfac=dsqrt(sinfac2)
5310 if (it.eq.10) goto 1
5312 C Compute the axes of tghe local cartesian coordinates system; store in
5313 c x_prime, y_prime and z_prime
5320 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5321 C & dc_norm(3,i+nres)
5323 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5324 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5327 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5330 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5331 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5332 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5333 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5334 c & " xy",scalar(x_prime(1),y_prime(1)),
5335 c & " xz",scalar(x_prime(1),z_prime(1)),
5336 c & " yy",scalar(y_prime(1),y_prime(1)),
5337 c & " yz",scalar(y_prime(1),z_prime(1)),
5338 c & " zz",scalar(z_prime(1),z_prime(1))
5340 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5341 C to local coordinate system. Store in xx, yy, zz.
5347 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5348 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5349 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5356 C Compute the energy of the ith side cbain
5358 c write (2,*) "xx",xx," yy",yy," zz",zz
5361 x(j) = sc_parmin(j,it)
5364 Cc diagnostics - remove later
5366 yy1 = dsin(alph(2))*dcos(omeg(2))
5367 zz1 = -dsign(1.0, dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5368 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5369 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5371 C," --- ", xx_w,yy_w,zz_w
5374 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5375 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5377 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5378 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5380 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5381 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5382 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5383 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5384 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5386 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5387 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5388 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5389 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5390 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5392 dsc_i = 0.743d0+x(61)
5394 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5395 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5396 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5397 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5398 s1=(1+x(63))/(0.1d0 + dscp1)
5399 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5400 s2=(1+x(65))/(0.1d0 + dscp2)
5401 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5402 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5403 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5404 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5406 c & dscp1,dscp2,sumene
5407 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5408 escloc = escloc + sumene
5409 c write (2,*) "i",i," escloc",sumene,escloc
5412 C This section to check the numerical derivatives of the energy of ith side
5413 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5414 C #define DEBUG in the code to turn it on.
5416 write (2,*) "sumene =",sumene
5420 write (2,*) xx,yy,zz
5421 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5422 de_dxx_num=(sumenep-sumene)/aincr
5424 write (2,*) "xx+ sumene from enesc=",sumenep
5427 write (2,*) xx,yy,zz
5428 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5429 de_dyy_num=(sumenep-sumene)/aincr
5431 write (2,*) "yy+ sumene from enesc=",sumenep
5434 write (2,*) xx,yy,zz
5435 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5436 de_dzz_num=(sumenep-sumene)/aincr
5438 write (2,*) "zz+ sumene from enesc=",sumenep
5439 costsave=cost2tab(i+1)
5440 sintsave=sint2tab(i+1)
5441 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5442 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5443 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5444 de_dt_num=(sumenep-sumene)/aincr
5445 write (2,*) " t+ sumene from enesc=",sumenep
5446 cost2tab(i+1)=costsave
5447 sint2tab(i+1)=sintsave
5448 C End of diagnostics section.
5451 C Compute the gradient of esc
5453 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5454 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5455 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5456 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5457 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5458 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5459 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5460 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5461 pom1=(sumene3*sint2tab(i+1)+sumene1)
5462 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5463 pom2=(sumene4*cost2tab(i+1)+sumene2)
5464 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5465 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5466 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5467 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5469 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5470 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5471 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5473 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5474 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5475 & +(pom1+pom2)*pom_dx
5477 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5480 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5481 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5482 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5484 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5485 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5486 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5487 & +x(59)*zz**2 +x(60)*xx*zz
5488 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5489 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5490 & +(pom1-pom2)*pom_dy
5492 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5495 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5496 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5497 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5498 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5499 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5500 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5501 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5502 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5504 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5507 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5508 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5509 & +pom1*pom_dt1+pom2*pom_dt2
5511 write(2,*), "de_dt = ", de_dt,de_dt_num
5515 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5516 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5517 cosfac2xx=cosfac2*xx
5518 sinfac2yy=sinfac2*yy
5520 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5522 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5524 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5525 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5526 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5527 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5528 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5529 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5530 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5531 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5532 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5533 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5537 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5538 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5539 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5540 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5543 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5544 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5545 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5547 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5548 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5552 dXX_Ctab(k,i)=dXX_Ci(k)
5553 dXX_C1tab(k,i)=dXX_Ci1(k)
5554 dYY_Ctab(k,i)=dYY_Ci(k)
5555 dYY_C1tab(k,i)=dYY_Ci1(k)
5556 dZZ_Ctab(k,i)=dZZ_Ci(k)
5557 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5558 dXX_XYZtab(k,i)=dXX_XYZ(k)
5559 dYY_XYZtab(k,i)=dYY_XYZ(k)
5560 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5564 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5565 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5566 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5567 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5568 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5570 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5571 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5572 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5573 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5574 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5575 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5576 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5577 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5579 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5580 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5582 C to check gradient call subroutine check_grad
5588 c------------------------------------------------------------------------------
5589 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5591 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5592 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5593 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5594 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5596 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5597 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5599 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5600 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5601 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5602 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5603 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5605 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5606 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5607 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5608 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5609 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5611 dsc_i = 0.743d0+x(61)
5613 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5614 & *(xx*cost2+yy*sint2))
5615 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5616 & *(xx*cost2-yy*sint2))
5617 s1=(1+x(63))/(0.1d0 + dscp1)
5618 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5619 s2=(1+x(65))/(0.1d0 + dscp2)
5620 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5621 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5622 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5627 c------------------------------------------------------------------------------
5628 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5630 C This procedure calculates two-body contact function g(rij) and its derivative:
5633 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5636 C where x=(rij-r0ij)/delta
5638 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5641 double precision rij,r0ij,eps0ij,fcont,fprimcont
5642 double precision x,x2,x4,delta
5646 if (x.lt.-1.0D0) then
5649 else if (x.le.1.0D0) then
5652 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5653 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5660 c------------------------------------------------------------------------------
5661 subroutine splinthet(theti,delta,ss,ssder)
5662 implicit real*8 (a-h,o-z)
5663 include 'DIMENSIONS'
5664 include 'COMMON.VAR'
5665 include 'COMMON.GEO'
5668 if (theti.gt.pipol) then
5669 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5671 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5676 c------------------------------------------------------------------------------
5677 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5679 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5680 double precision ksi,ksi2,ksi3,a1,a2,a3
5681 a1=fprim0*delta/(f1-f0)
5687 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5688 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5691 c------------------------------------------------------------------------------
5692 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5694 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5695 double precision ksi,ksi2,ksi3,a1,a2,a3
5700 a2=3*(f1x-f0x)-2*fprim0x*delta
5701 a3=fprim0x*delta-2*(f1x-f0x)
5702 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5705 C-----------------------------------------------------------------------------
5707 C-----------------------------------------------------------------------------
5708 subroutine etor(etors,edihcnstr)
5709 implicit real*8 (a-h,o-z)
5710 include 'DIMENSIONS'
5711 include 'COMMON.VAR'
5712 include 'COMMON.GEO'
5713 include 'COMMON.LOCAL'
5714 include 'COMMON.TORSION'
5715 include 'COMMON.INTERACT'
5716 include 'COMMON.DERIV'
5717 include 'COMMON.CHAIN'
5718 include 'COMMON.NAMES'
5719 include 'COMMON.IOUNITS'
5720 include 'COMMON.FFIELD'
5721 include 'COMMON.TORCNSTR'
5722 include 'COMMON.CONTROL'
5724 C Set lprn=.true. for debugging
5728 do i=iphi_start,iphi_end
5730 itori=itortyp(itype(i-2))
5731 itori1=itortyp(itype(i-1))
5734 C Proline-Proline pair is a special case...
5735 if (itori.eq.3 .and. itori1.eq.3) then
5736 if (phii.gt.-dwapi3) then
5738 fac=1.0D0/(1.0D0-cosphi)
5739 etorsi=v1(1,3,3)*fac
5740 etorsi=etorsi+etorsi
5741 etors=etors+etorsi-v1(1,3,3)
5742 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5743 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5746 v1ij=v1(j+1,itori,itori1)
5747 v2ij=v2(j+1,itori,itori1)
5750 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5751 if (energy_dec) etors_ii=etors_ii+
5752 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5753 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5757 v1ij=v1(j,itori,itori1)
5758 v2ij=v2(j,itori,itori1)
5761 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5762 if (energy_dec) etors_ii=etors_ii+
5763 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5764 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5767 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5770 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5771 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5772 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5773 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5774 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5776 ! 6/20/98 - dihedral angle constraints
5779 itori=idih_constr(i)
5782 if (difi.gt.drange(i)) then
5784 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5785 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5786 else if (difi.lt.-drange(i)) then
5788 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5789 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5791 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5792 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5794 ! write (iout,*) 'edihcnstr',edihcnstr
5797 c------------------------------------------------------------------------------
5798 subroutine etor_d(etors_d)
5802 c----------------------------------------------------------------------------
5804 subroutine etor(etors,edihcnstr)
5805 implicit real*8 (a-h,o-z)
5806 include 'DIMENSIONS'
5807 include 'COMMON.VAR'
5808 include 'COMMON.GEO'
5809 include 'COMMON.LOCAL'
5810 include 'COMMON.TORSION'
5811 include 'COMMON.INTERACT'
5812 include 'COMMON.DERIV'
5813 include 'COMMON.CHAIN'
5814 include 'COMMON.NAMES'
5815 include 'COMMON.IOUNITS'
5816 include 'COMMON.FFIELD'
5817 include 'COMMON.TORCNSTR'
5818 include 'COMMON.CONTROL'
5820 C Set lprn=.true. for debugging
5824 do i=iphi_start,iphi_end
5826 c if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5827 c & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5828 itori=itortyp(itype(i-2))
5829 itori1=itortyp(itype(i-1))
5832 C Regular cosine and sine terms
5833 do j=1,nterm(itori,itori1)
5834 v1ij=v1(j,itori,itori1)
5835 v2ij=v2(j,itori,itori1)
5838 etors=etors+v1ij*cosphi+v2ij*sinphi
5839 if (energy_dec) etors_ii=etors_ii+
5840 & v1ij*cosphi+v2ij*sinphi
5841 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5845 C E = SUM ----------------------------------- - v1
5846 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5848 cosphi=dcos(0.5d0*phii)
5849 sinphi=dsin(0.5d0*phii)
5850 do j=1,nlor(itori,itori1)
5851 vl1ij=vlor1(j,itori,itori1)
5852 vl2ij=vlor2(j,itori,itori1)
5853 vl3ij=vlor3(j,itori,itori1)
5854 pom=vl2ij*cosphi+vl3ij*sinphi
5855 pom1=1.0d0/(pom*pom+1.0d0)
5856 etors=etors+vl1ij*pom1
5857 if (energy_dec) etors_ii=etors_ii+
5860 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5862 C Subtract the constant term
5863 etors=etors-v0(itori,itori1)
5864 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5865 & 'etor',i,etors_ii-v0(itori,itori1)
5867 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5868 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5869 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5870 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5871 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5873 ! 6/20/98 - dihedral angle constraints
5875 c do i=1,ndih_constr
5876 do i=idihconstr_start,idihconstr_end
5877 itori=idih_constr(i)
5879 difi=pinorm(phii-phi0(i))
5880 if (difi.gt.drange(i)) then
5882 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5883 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5884 else if (difi.lt.-drange(i)) then
5886 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5887 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5891 c write (iout,*) "gloci", gloc(i-3,icg)
5892 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5893 cd & rad2deg*phi0(i), rad2deg*drange(i),
5894 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5896 cd write (iout,*) 'edihcnstr',edihcnstr
5899 c----------------------------------------------------------------------------
5900 subroutine etor_d(etors_d)
5901 C 6/23/01 Compute double torsional energy
5902 implicit real*8 (a-h,o-z)
5903 include 'DIMENSIONS'
5904 include 'COMMON.VAR'
5905 include 'COMMON.GEO'
5906 include 'COMMON.LOCAL'
5907 include 'COMMON.TORSION'
5908 include 'COMMON.INTERACT'
5909 include 'COMMON.DERIV'
5910 include 'COMMON.CHAIN'
5911 include 'COMMON.NAMES'
5912 include 'COMMON.IOUNITS'
5913 include 'COMMON.FFIELD'
5914 include 'COMMON.TORCNSTR'
5916 C Set lprn=.true. for debugging
5920 do i=iphid_start,iphid_end
5921 c if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5922 c & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5923 itori=itortyp(itype(i-2))
5924 itori1=itortyp(itype(i-1))
5925 itori2=itortyp(itype(i))
5930 do j=1,ntermd_1(itori,itori1,itori2)
5931 v1cij=v1c(1,j,itori,itori1,itori2)
5932 v1sij=v1s(1,j,itori,itori1,itori2)
5933 v2cij=v1c(2,j,itori,itori1,itori2)
5934 v2sij=v1s(2,j,itori,itori1,itori2)
5935 cosphi1=dcos(j*phii)
5936 sinphi1=dsin(j*phii)
5937 cosphi2=dcos(j*phii1)
5938 sinphi2=dsin(j*phii1)
5939 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5940 & v2cij*cosphi2+v2sij*sinphi2
5941 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5942 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5944 do k=2,ntermd_2(itori,itori1,itori2)
5946 v1cdij = v2c(k,l,itori,itori1,itori2)
5947 v2cdij = v2c(l,k,itori,itori1,itori2)
5948 v1sdij = v2s(k,l,itori,itori1,itori2)
5949 v2sdij = v2s(l,k,itori,itori1,itori2)
5950 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5951 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5952 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5953 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5954 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5955 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5956 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5957 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5958 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5959 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5962 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5963 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5964 c write (iout,*) "gloci", gloc(i-3,icg)
5969 c------------------------------------------------------------------------------
5970 subroutine eback_sc_corr(esccor)
5971 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5972 c conformational states; temporarily implemented as differences
5973 c between UNRES torsional potentials (dependent on three types of
5974 c residues) and the torsional potentials dependent on all 20 types
5975 c of residues computed from AM1 energy surfaces of terminally-blocked
5976 c amino-acid residues.
5977 implicit real*8 (a-h,o-z)
5978 include 'DIMENSIONS'
5979 include 'COMMON.VAR'
5980 include 'COMMON.GEO'
5981 include 'COMMON.LOCAL'
5982 include 'COMMON.TORSION'
5983 include 'COMMON.SCCOR'
5984 include 'COMMON.INTERACT'
5985 include 'COMMON.DERIV'
5986 include 'COMMON.CHAIN'
5987 include 'COMMON.NAMES'
5988 include 'COMMON.IOUNITS'
5989 include 'COMMON.FFIELD'
5990 include 'COMMON.CONTROL'
5992 C Set lprn=.true. for debugging
5995 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5997 do i=itau_start,itau_end
5999 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6000 isccori=isccortyp(itype(i-2))
6001 isccori1=isccortyp(itype(i-1))
6003 cccc Added 9 May 2012
6004 cc Tauangle is torsional engle depending on the value of first digit
6005 c(see comment below)
6006 cc Omicron is flat angle depending on the value of first digit
6007 c(see comment below)
6010 do intertyp=1,3 !intertyp
6011 cc Added 09 May 2012 (Adasko)
6012 cc Intertyp means interaction type of backbone mainchain correlation:
6013 c 1 = SC...Ca...Ca...Ca
6014 c 2 = Ca...Ca...Ca...SC
6015 c 3 = SC...Ca...Ca...SCi
6017 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6018 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6019 & (itype(i-1).eq.ntyp1)))
6020 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6021 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6022 & .or.(itype(i).eq.ntyp1)))
6023 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6024 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6025 & (itype(i-3).eq.ntyp1)))) cycle
6026 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6027 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6029 do j=1,nterm_sccor(isccori,isccori1)
6030 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6031 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6032 cosphi=dcos(j*tauangle(intertyp,i))
6033 sinphi=dsin(j*tauangle(intertyp,i))
6034 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6035 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6037 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6038 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6039 c &gloc_sc(intertyp,i-3,icg)
6041 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6042 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6043 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6044 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6045 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6049 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6053 c----------------------------------------------------------------------------
6054 subroutine multibody(ecorr)
6055 C This subroutine calculates multi-body contributions to energy following
6056 C the idea of Skolnick et al. If side chains I and J make a contact and
6057 C at the same time side chains I+1 and J+1 make a contact, an extra
6058 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6059 implicit real*8 (a-h,o-z)
6060 include 'DIMENSIONS'
6061 include 'COMMON.IOUNITS'
6062 include 'COMMON.DERIV'
6063 include 'COMMON.INTERACT'
6064 include 'COMMON.CONTACTS'
6065 double precision gx(3),gx1(3)
6068 C Set lprn=.true. for debugging
6072 write (iout,'(a)') 'Contact function values:'
6074 write (iout,'(i2,20(1x,i2,f10.5))')
6075 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6090 num_conti=num_cont(i)
6091 num_conti1=num_cont(i1)
6096 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6097 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6098 cd & ' ishift=',ishift
6099 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6100 C The system gains extra energy.
6101 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6102 endif ! j1==j+-ishift
6111 c------------------------------------------------------------------------------
6112 double precision function esccorr(i,j,k,l,jj,kk)
6113 implicit real*8 (a-h,o-z)
6114 include 'DIMENSIONS'
6115 include 'COMMON.IOUNITS'
6116 include 'COMMON.DERIV'
6117 include 'COMMON.INTERACT'
6118 include 'COMMON.CONTACTS'
6119 double precision gx(3),gx1(3)
6124 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6125 C Calculate the multi-body contribution to energy.
6126 C Calculate multi-body contributions to the gradient.
6127 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6128 cd & k,l,(gacont(m,kk,k),m=1,3)
6130 gx(m) =ekl*gacont(m,jj,i)
6131 gx1(m)=eij*gacont(m,kk,k)
6132 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6133 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6134 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6135 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6139 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6144 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6150 c------------------------------------------------------------------------------
6151 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6152 C This subroutine calculates multi-body contributions to hydrogen-bonding
6153 implicit real*8 (a-h,o-z)
6154 include 'DIMENSIONS'
6155 include 'COMMON.IOUNITS'
6158 parameter (max_cont=maxconts)
6159 parameter (max_dim=26)
6160 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6161 double precision zapas(max_dim,maxconts,max_fg_procs),
6162 & zapas_recv(max_dim,maxconts,max_fg_procs)
6163 common /przechowalnia/ zapas
6164 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6165 & status_array(MPI_STATUS_SIZE,maxconts*2)
6167 include 'COMMON.SETUP'
6168 include 'COMMON.FFIELD'
6169 include 'COMMON.DERIV'
6170 include 'COMMON.INTERACT'
6171 include 'COMMON.CONTACTS'
6172 include 'COMMON.CONTROL'
6173 include 'COMMON.LOCAL'
6174 double precision gx(3),gx1(3),time00
6177 C Set lprn=.true. for debugging
6182 if (nfgtasks.le.1) goto 30
6184 write (iout,'(a)') 'Contact function values before RECEIVE:'
6186 write (iout,'(2i3,50(1x,i2,f5.2))')
6187 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6188 & j=1,num_cont_hb(i))
6192 do i=1,ntask_cont_from
6195 do i=1,ntask_cont_to
6198 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6200 C Make the list of contacts to send to send to other procesors
6201 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6203 do i=iturn3_start,iturn3_end
6204 c write (iout,*) "make contact list turn3",i," num_cont",
6206 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6208 do i=iturn4_start,iturn4_end
6209 c write (iout,*) "make contact list turn4",i," num_cont",
6211 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6215 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6217 do j=1,num_cont_hb(i)
6220 iproc=iint_sent_local(k,jjc,ii)
6221 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6222 if (iproc.gt.0) then
6223 ncont_sent(iproc)=ncont_sent(iproc)+1
6224 nn=ncont_sent(iproc)
6226 zapas(2,nn,iproc)=jjc
6227 zapas(3,nn,iproc)=facont_hb(j,i)
6228 zapas(4,nn,iproc)=ees0p(j,i)
6229 zapas(5,nn,iproc)=ees0m(j,i)
6230 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6231 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6232 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6233 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6234 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6235 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6236 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6237 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6238 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6239 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6240 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6241 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6242 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6243 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6244 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6245 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6246 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6247 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6248 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6249 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6250 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6257 & "Numbers of contacts to be sent to other processors",
6258 & (ncont_sent(i),i=1,ntask_cont_to)
6259 write (iout,*) "Contacts sent"
6260 do ii=1,ntask_cont_to
6262 iproc=itask_cont_to(ii)
6263 write (iout,*) nn," contacts to processor",iproc,
6264 & " of CONT_TO_COMM group"
6266 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6274 CorrelID1=nfgtasks+fg_rank+1
6276 C Receive the numbers of needed contacts from other processors
6277 do ii=1,ntask_cont_from
6278 iproc=itask_cont_from(ii)
6280 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6281 & FG_COMM,req(ireq),IERR)
6283 c write (iout,*) "IRECV ended"
6285 C Send the number of contacts needed by other processors
6286 do ii=1,ntask_cont_to
6287 iproc=itask_cont_to(ii)
6289 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6290 & FG_COMM,req(ireq),IERR)
6292 c write (iout,*) "ISEND ended"
6293 c write (iout,*) "number of requests (nn)",ireq
6296 & call MPI_Waitall(ireq,req,status_array,ierr)
6298 c & "Numbers of contacts to be received from other processors",
6299 c & (ncont_recv(i),i=1,ntask_cont_from)
6303 do ii=1,ntask_cont_from
6304 iproc=itask_cont_from(ii)
6306 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6307 c & " of CONT_TO_COMM group"
6311 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6312 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6313 c write (iout,*) "ireq,req",ireq,req(ireq)
6316 C Send the contacts to processors that need them
6317 do ii=1,ntask_cont_to
6318 iproc=itask_cont_to(ii)
6320 c write (iout,*) nn," contacts to processor",iproc,
6321 c & " of CONT_TO_COMM group"
6324 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6325 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6326 c write (iout,*) "ireq,req",ireq,req(ireq)
6328 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6332 c write (iout,*) "number of requests (contacts)",ireq
6333 c write (iout,*) "req",(req(i),i=1,4)
6336 & call MPI_Waitall(ireq,req,status_array,ierr)
6337 do iii=1,ntask_cont_from
6338 iproc=itask_cont_from(iii)
6341 write (iout,*) "Received",nn," contacts from processor",iproc,
6342 & " of CONT_FROM_COMM group"
6345 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6350 ii=zapas_recv(1,i,iii)
6351 c Flag the received contacts to prevent double-counting
6352 jj=-zapas_recv(2,i,iii)
6353 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6355 nnn=num_cont_hb(ii)+1
6358 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6359 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6360 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6361 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6362 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6363 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6364 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6365 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6366 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6367 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6368 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6369 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6370 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6371 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6372 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6373 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6374 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6375 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6376 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6377 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6378 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6379 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6380 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6381 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6386 write (iout,'(a)') 'Contact function values after receive:'
6388 write (iout,'(2i3,50(1x,i3,f5.2))')
6389 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6390 & j=1,num_cont_hb(i))
6397 write (iout,'(a)') 'Contact function values:'
6399 write (iout,'(2i3,50(1x,i3,f5.2))')
6400 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6401 & j=1,num_cont_hb(i))
6405 C Remove the loop below after debugging !!!
6412 C Calculate the local-electrostatic correlation terms
6413 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6415 num_conti=num_cont_hb(i)
6416 num_conti1=num_cont_hb(i+1)
6423 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6424 c & ' jj=',jj,' kk=',kk
6425 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6426 & .or. j.lt.0 .and. j1.gt.0) .and.
6427 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6428 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6429 C The system gains extra energy.
6430 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6431 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6432 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6434 else if (j1.eq.j) then
6435 C Contacts I-J and I-(J+1) occur simultaneously.
6436 C The system loses extra energy.
6437 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6442 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6443 c & ' jj=',jj,' kk=',kk
6445 C Contacts I-J and (I+1)-J occur simultaneously.
6446 C The system loses extra energy.
6447 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6454 c------------------------------------------------------------------------------
6455 subroutine add_hb_contact(ii,jj,itask)
6456 implicit real*8 (a-h,o-z)
6457 include "DIMENSIONS"
6458 include "COMMON.IOUNITS"
6461 parameter (max_cont=maxconts)
6462 parameter (max_dim=26)
6463 include "COMMON.CONTACTS"
6464 double precision zapas(max_dim,maxconts,max_fg_procs),
6465 & zapas_recv(max_dim,maxconts,max_fg_procs)
6466 common /przechowalnia/ zapas
6467 integer i,j,ii,jj,iproc,itask(4),nn
6468 c write (iout,*) "itask",itask
6471 if (iproc.gt.0) then
6472 do j=1,num_cont_hb(ii)
6474 c write (iout,*) "i",ii," j",jj," jjc",jjc
6476 ncont_sent(iproc)=ncont_sent(iproc)+1
6477 nn=ncont_sent(iproc)
6478 zapas(1,nn,iproc)=ii
6479 zapas(2,nn,iproc)=jjc
6480 zapas(3,nn,iproc)=facont_hb(j,ii)
6481 zapas(4,nn,iproc)=ees0p(j,ii)
6482 zapas(5,nn,iproc)=ees0m(j,ii)
6483 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6484 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6485 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6486 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6487 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6488 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6489 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6490 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6491 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6492 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6493 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6494 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6495 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6496 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6497 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6498 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6499 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6500 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6501 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6502 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6503 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6511 c------------------------------------------------------------------------------
6512 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6514 C This subroutine calculates multi-body contributions to hydrogen-bonding
6515 implicit real*8 (a-h,o-z)
6516 include 'DIMENSIONS'
6517 include 'COMMON.IOUNITS'
6520 parameter (max_cont=maxconts)
6521 parameter (max_dim=70)
6522 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6523 double precision zapas(max_dim,maxconts,max_fg_procs),
6524 & zapas_recv(max_dim,maxconts,max_fg_procs)
6525 common /przechowalnia/ zapas
6526 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6527 & status_array(MPI_STATUS_SIZE,maxconts*2)
6529 include 'COMMON.SETUP'
6530 include 'COMMON.FFIELD'
6531 include 'COMMON.DERIV'
6532 include 'COMMON.LOCAL'
6533 include 'COMMON.INTERACT'
6534 include 'COMMON.CONTACTS'
6535 include 'COMMON.CHAIN'
6536 include 'COMMON.CONTROL'
6537 double precision gx(3),gx1(3)
6538 integer num_cont_hb_old(maxres)
6540 double precision eello4,eello5,eelo6,eello_turn6
6541 external eello4,eello5,eello6,eello_turn6
6542 C Set lprn=.true. for debugging
6547 num_cont_hb_old(i)=num_cont_hb(i)
6551 if (nfgtasks.le.1) goto 30
6553 write (iout,'(a)') 'Contact function values before RECEIVE:'
6555 write (iout,'(2i3,50(1x,i2,f5.2))')
6556 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6557 & j=1,num_cont_hb(i))
6561 do i=1,ntask_cont_from
6564 do i=1,ntask_cont_to
6567 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6569 C Make the list of contacts to send to send to other procesors
6570 do i=iturn3_start,iturn3_end
6571 c write (iout,*) "make contact list turn3",i," num_cont",
6573 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6575 do i=iturn4_start,iturn4_end
6576 c write (iout,*) "make contact list turn4",i," num_cont",
6578 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6582 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6584 do j=1,num_cont_hb(i)
6587 iproc=iint_sent_local(k,jjc,ii)
6588 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6589 if (iproc.ne.0) then
6590 ncont_sent(iproc)=ncont_sent(iproc)+1
6591 nn=ncont_sent(iproc)
6593 zapas(2,nn,iproc)=jjc
6594 zapas(3,nn,iproc)=d_cont(j,i)
6598 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6603 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6611 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6622 & "Numbers of contacts to be sent to other processors",
6623 & (ncont_sent(i),i=1,ntask_cont_to)
6624 write (iout,*) "Contacts sent"
6625 do ii=1,ntask_cont_to
6627 iproc=itask_cont_to(ii)
6628 write (iout,*) nn," contacts to processor",iproc,
6629 & " of CONT_TO_COMM group"
6631 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6639 CorrelID1=nfgtasks+fg_rank+1
6641 C Receive the numbers of needed contacts from other processors
6642 do ii=1,ntask_cont_from
6643 iproc=itask_cont_from(ii)
6645 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6646 & FG_COMM,req(ireq),IERR)
6648 c write (iout,*) "IRECV ended"
6650 C Send the number of contacts needed by other processors
6651 do ii=1,ntask_cont_to
6652 iproc=itask_cont_to(ii)
6654 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6655 & FG_COMM,req(ireq),IERR)
6657 c write (iout,*) "ISEND ended"
6658 c write (iout,*) "number of requests (nn)",ireq
6661 & call MPI_Waitall(ireq,req,status_array,ierr)
6663 c & "Numbers of contacts to be received from other processors",
6664 c & (ncont_recv(i),i=1,ntask_cont_from)
6668 do ii=1,ntask_cont_from
6669 iproc=itask_cont_from(ii)
6671 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6672 c & " of CONT_TO_COMM group"
6676 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6677 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6678 c write (iout,*) "ireq,req",ireq,req(ireq)
6681 C Send the contacts to processors that need them
6682 do ii=1,ntask_cont_to
6683 iproc=itask_cont_to(ii)
6685 c write (iout,*) nn," contacts to processor",iproc,
6686 c & " of CONT_TO_COMM group"
6689 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6690 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6691 c write (iout,*) "ireq,req",ireq,req(ireq)
6693 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6697 c write (iout,*) "number of requests (contacts)",ireq
6698 c write (iout,*) "req",(req(i),i=1,4)
6701 & call MPI_Waitall(ireq,req,status_array,ierr)
6702 do iii=1,ntask_cont_from
6703 iproc=itask_cont_from(iii)
6706 write (iout,*) "Received",nn," contacts from processor",iproc,
6707 & " of CONT_FROM_COMM group"
6710 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6715 ii=zapas_recv(1,i,iii)
6716 c Flag the received contacts to prevent double-counting
6717 jj=-zapas_recv(2,i,iii)
6718 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6720 nnn=num_cont_hb(ii)+1
6723 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6727 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6732 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6740 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6749 write (iout,'(a)') 'Contact function values after receive:'
6751 write (iout,'(2i3,50(1x,i3,5f6.3))')
6752 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6753 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6760 write (iout,'(a)') 'Contact function values:'
6762 write (iout,'(2i3,50(1x,i2,5f6.3))')
6763 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6764 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6770 C Remove the loop below after debugging !!!
6777 C Calculate the dipole-dipole interaction energies
6778 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6779 do i=iatel_s,iatel_e+1
6780 num_conti=num_cont_hb(i)
6789 C Calculate the local-electrostatic correlation terms
6790 c write (iout,*) "gradcorr5 in eello5 before loop"
6792 c write (iout,'(i5,3f10.5)')
6793 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6795 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6796 c write (iout,*) "corr loop i",i
6798 num_conti=num_cont_hb(i)
6799 num_conti1=num_cont_hb(i+1)
6806 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6807 c & ' jj=',jj,' kk=',kk
6808 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6809 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6810 & .or. j.lt.0 .and. j1.gt.0) .and.
6811 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6812 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6813 C The system gains extra energy.
6815 sqd1=dsqrt(d_cont(jj,i))
6816 sqd2=dsqrt(d_cont(kk,i1))
6817 sred_geom = sqd1*sqd2
6818 IF (sred_geom.lt.cutoff_corr) THEN
6819 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6821 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6822 cd & ' jj=',jj,' kk=',kk
6823 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6824 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6826 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6827 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6830 cd write (iout,*) 'sred_geom=',sred_geom,
6831 cd & ' ekont=',ekont,' fprim=',fprimcont,
6832 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6833 cd write (iout,*) "g_contij",g_contij
6834 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6835 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6836 call calc_eello(i,jp,i+1,jp1,jj,kk)
6837 if (wcorr4.gt.0.0d0)
6838 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6839 if (energy_dec.and.wcorr4.gt.0.0d0)
6840 1 write (iout,'(a6,4i5,0pf7.3)')
6841 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6842 c write (iout,*) "gradcorr5 before eello5"
6844 c write (iout,'(i5,3f10.5)')
6845 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6847 if (wcorr5.gt.0.0d0)
6848 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6849 c write (iout,*) "gradcorr5 after eello5"
6851 c write (iout,'(i5,3f10.5)')
6852 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6854 if (energy_dec.and.wcorr5.gt.0.0d0)
6855 1 write (iout,'(a6,4i5,0pf7.3)')
6856 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6857 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6858 cd write(2,*)'ijkl',i,jp,i+1,jp1
6859 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6860 & .or. wturn6.eq.0.0d0))then
6861 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6862 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6863 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6864 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6865 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6866 cd & 'ecorr6=',ecorr6
6867 cd write (iout,'(4e15.5)') sred_geom,
6868 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6869 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6870 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6871 else if (wturn6.gt.0.0d0
6872 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6873 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6874 eturn6=eturn6+eello_turn6(i,jj,kk)
6875 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6876 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6877 cd write (2,*) 'multibody_eello:eturn6',eturn6
6886 num_cont_hb(i)=num_cont_hb_old(i)
6888 c write (iout,*) "gradcorr5 in eello5"
6890 c write (iout,'(i5,3f10.5)')
6891 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6895 c------------------------------------------------------------------------------
6896 subroutine add_hb_contact_eello(ii,jj,itask)
6897 implicit real*8 (a-h,o-z)
6898 include "DIMENSIONS"
6899 include "COMMON.IOUNITS"
6902 parameter (max_cont=maxconts)
6903 parameter (max_dim=70)
6904 include "COMMON.CONTACTS"
6905 double precision zapas(max_dim,maxconts,max_fg_procs),
6906 & zapas_recv(max_dim,maxconts,max_fg_procs)
6907 common /przechowalnia/ zapas
6908 integer i,j,ii,jj,iproc,itask(4),nn
6909 c write (iout,*) "itask",itask
6912 if (iproc.gt.0) then
6913 do j=1,num_cont_hb(ii)
6915 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6917 ncont_sent(iproc)=ncont_sent(iproc)+1
6918 nn=ncont_sent(iproc)
6919 zapas(1,nn,iproc)=ii
6920 zapas(2,nn,iproc)=jjc
6921 zapas(3,nn,iproc)=d_cont(j,ii)
6925 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6930 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6938 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6950 c------------------------------------------------------------------------------
6951 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6952 implicit real*8 (a-h,o-z)
6953 include 'DIMENSIONS'
6954 include 'COMMON.IOUNITS'
6955 include 'COMMON.DERIV'
6956 include 'COMMON.INTERACT'
6957 include 'COMMON.CONTACTS'
6958 double precision gx(3),gx1(3)
6968 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6969 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6970 C Following 4 lines for diagnostics.
6975 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6976 c & 'Contacts ',i,j,
6977 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6978 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6980 C Calculate the multi-body contribution to energy.
6981 c ecorr=ecorr+ekont*ees
6982 C Calculate multi-body contributions to the gradient.
6983 coeffpees0pij=coeffp*ees0pij
6984 coeffmees0mij=coeffm*ees0mij
6985 coeffpees0pkl=coeffp*ees0pkl
6986 coeffmees0mkl=coeffm*ees0mkl
6988 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6989 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6990 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6991 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6992 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6993 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6994 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6995 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6996 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6997 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6998 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6999 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7000 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7001 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7002 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7003 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7004 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7005 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7006 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7007 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7008 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7009 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7010 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7011 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7012 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7017 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7018 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7019 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7020 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7025 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7026 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7027 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7028 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7031 c write (iout,*) "ehbcorr",ekont*ees
7036 C---------------------------------------------------------------------------
7037 subroutine dipole(i,j,jj)
7038 implicit real*8 (a-h,o-z)
7039 include 'DIMENSIONS'
7040 include 'COMMON.IOUNITS'
7041 include 'COMMON.CHAIN'
7042 include 'COMMON.FFIELD'
7043 include 'COMMON.DERIV'
7044 include 'COMMON.INTERACT'
7045 include 'COMMON.CONTACTS'
7046 include 'COMMON.TORSION'
7047 include 'COMMON.VAR'
7048 include 'COMMON.GEO'
7049 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7051 iti1 = itortyp(itype(i+1))
7052 if (j.lt.nres-1) then
7053 itj1 = itortyp(itype(j+1))
7058 dipi(iii,1)=Ub2(iii,i)
7059 dipderi(iii)=Ub2der(iii,i)
7060 dipi(iii,2)=b1(iii,iti1)
7061 dipj(iii,1)=Ub2(iii,j)
7062 dipderj(iii)=Ub2der(iii,j)
7063 dipj(iii,2)=b1(iii,itj1)
7067 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7070 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7077 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7081 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7086 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7087 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7089 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7091 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7093 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7098 C---------------------------------------------------------------------------
7099 subroutine calc_eello(i,j,k,l,jj,kk)
7101 C This subroutine computes matrices and vectors needed to calculate
7102 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7104 implicit real*8 (a-h,o-z)
7105 include 'DIMENSIONS'
7106 include 'COMMON.IOUNITS'
7107 include 'COMMON.CHAIN'
7108 include 'COMMON.DERIV'
7109 include 'COMMON.INTERACT'
7110 include 'COMMON.CONTACTS'
7111 include 'COMMON.TORSION'
7112 include 'COMMON.VAR'
7113 include 'COMMON.GEO'
7114 include 'COMMON.FFIELD'
7115 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7116 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7119 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7120 cd & ' jj=',jj,' kk=',kk
7121 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7122 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7123 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7126 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7127 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7130 call transpose2(aa1(1,1),aa1t(1,1))
7131 call transpose2(aa2(1,1),aa2t(1,1))
7134 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7135 & aa1tder(1,1,lll,kkk))
7136 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7137 & aa2tder(1,1,lll,kkk))
7141 C parallel orientation of the two CA-CA-CA frames.
7143 iti=itortyp(itype(i))
7147 itk1=itortyp(itype(k+1))
7148 itj=itortyp(itype(j))
7149 if (l.lt.nres-1) then
7150 itl1=itortyp(itype(l+1))
7154 C A1 kernel(j+1) A2T
7156 cd write (iout,'(3f10.5,5x,3f10.5)')
7157 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7159 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7160 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7161 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7162 C Following matrices are needed only for 6-th order cumulants
7163 IF (wcorr6.gt.0.0d0) THEN
7164 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7165 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7166 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7167 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7168 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7169 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7170 & ADtEAderx(1,1,1,1,1,1))
7172 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7173 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7174 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7175 & ADtEA1derx(1,1,1,1,1,1))
7177 C End 6-th order cumulants
7180 cd write (2,*) 'In calc_eello6'
7182 cd write (2,*) 'iii=',iii
7184 cd write (2,*) 'kkk=',kkk
7186 cd write (2,'(3(2f10.5),5x)')
7187 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7192 call transpose2(EUgder(1,1,k),auxmat(1,1))
7193 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7194 call transpose2(EUg(1,1,k),auxmat(1,1))
7195 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7196 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7200 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7201 & EAEAderx(1,1,lll,kkk,iii,1))
7205 C A1T kernel(i+1) A2
7206 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7207 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7208 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7209 C Following matrices are needed only for 6-th order cumulants
7210 IF (wcorr6.gt.0.0d0) THEN
7211 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7212 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7213 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7214 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7215 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7216 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7217 & ADtEAderx(1,1,1,1,1,2))
7218 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7219 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7220 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7221 & ADtEA1derx(1,1,1,1,1,2))
7223 C End 6-th order cumulants
7224 call transpose2(EUgder(1,1,l),auxmat(1,1))
7225 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7226 call transpose2(EUg(1,1,l),auxmat(1,1))
7227 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7228 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7232 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7233 & EAEAderx(1,1,lll,kkk,iii,2))
7238 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7239 C They are needed only when the fifth- or the sixth-order cumulants are
7241 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7242 call transpose2(AEA(1,1,1),auxmat(1,1))
7243 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7244 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7245 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7246 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7247 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7248 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7249 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7250 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7251 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7252 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7253 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7254 call transpose2(AEA(1,1,2),auxmat(1,1))
7255 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7256 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7257 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7258 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7259 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7260 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7261 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7262 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7263 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7264 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7265 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7266 C Calculate the Cartesian derivatives of the vectors.
7270 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7271 call matvec2(auxmat(1,1),b1(1,iti),
7272 & AEAb1derx(1,lll,kkk,iii,1,1))
7273 call matvec2(auxmat(1,1),Ub2(1,i),
7274 & AEAb2derx(1,lll,kkk,iii,1,1))
7275 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7276 & AEAb1derx(1,lll,kkk,iii,2,1))
7277 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7278 & AEAb2derx(1,lll,kkk,iii,2,1))
7279 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7280 call matvec2(auxmat(1,1),b1(1,itj),
7281 & AEAb1derx(1,lll,kkk,iii,1,2))
7282 call matvec2(auxmat(1,1),Ub2(1,j),
7283 & AEAb2derx(1,lll,kkk,iii,1,2))
7284 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7285 & AEAb1derx(1,lll,kkk,iii,2,2))
7286 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7287 & AEAb2derx(1,lll,kkk,iii,2,2))
7294 C Antiparallel orientation of the two CA-CA-CA frames.
7296 iti=itortyp(itype(i))
7300 itk1=itortyp(itype(k+1))
7301 itl=itortyp(itype(l))
7302 itj=itortyp(itype(j))
7303 if (j.lt.nres-1) then
7304 itj1=itortyp(itype(j+1))
7308 C A2 kernel(j-1)T A1T
7309 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7310 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7311 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7312 C Following matrices are needed only for 6-th order cumulants
7313 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7314 & j.eq.i+4 .and. l.eq.i+3)) THEN
7315 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7316 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7317 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7318 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7319 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7320 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7321 & ADtEAderx(1,1,1,1,1,1))
7322 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7323 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7324 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7325 & ADtEA1derx(1,1,1,1,1,1))
7327 C End 6-th order cumulants
7328 call transpose2(EUgder(1,1,k),auxmat(1,1))
7329 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7330 call transpose2(EUg(1,1,k),auxmat(1,1))
7331 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7332 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7336 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7337 & EAEAderx(1,1,lll,kkk,iii,1))
7341 C A2T kernel(i+1)T A1
7342 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7343 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7344 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7345 C Following matrices are needed only for 6-th order cumulants
7346 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7347 & j.eq.i+4 .and. l.eq.i+3)) THEN
7348 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7349 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7350 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7351 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7352 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7353 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7354 & ADtEAderx(1,1,1,1,1,2))
7355 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7356 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7357 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7358 & ADtEA1derx(1,1,1,1,1,2))
7360 C End 6-th order cumulants
7361 call transpose2(EUgder(1,1,j),auxmat(1,1))
7362 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7363 call transpose2(EUg(1,1,j),auxmat(1,1))
7364 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7365 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7369 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7370 & EAEAderx(1,1,lll,kkk,iii,2))
7375 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7376 C They are needed only when the fifth- or the sixth-order cumulants are
7378 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7379 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7380 call transpose2(AEA(1,1,1),auxmat(1,1))
7381 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7382 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7383 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7384 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7385 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7386 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7387 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7388 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7389 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7390 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7391 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7392 call transpose2(AEA(1,1,2),auxmat(1,1))
7393 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7394 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7395 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7396 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7397 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7398 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7399 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7400 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7401 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7402 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7403 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7404 C Calculate the Cartesian derivatives of the vectors.
7408 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7409 call matvec2(auxmat(1,1),b1(1,iti),
7410 & AEAb1derx(1,lll,kkk,iii,1,1))
7411 call matvec2(auxmat(1,1),Ub2(1,i),
7412 & AEAb2derx(1,lll,kkk,iii,1,1))
7413 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7414 & AEAb1derx(1,lll,kkk,iii,2,1))
7415 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7416 & AEAb2derx(1,lll,kkk,iii,2,1))
7417 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7418 call matvec2(auxmat(1,1),b1(1,itl),
7419 & AEAb1derx(1,lll,kkk,iii,1,2))
7420 call matvec2(auxmat(1,1),Ub2(1,l),
7421 & AEAb2derx(1,lll,kkk,iii,1,2))
7422 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7423 & AEAb1derx(1,lll,kkk,iii,2,2))
7424 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7425 & AEAb2derx(1,lll,kkk,iii,2,2))
7434 C---------------------------------------------------------------------------
7435 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7436 & KK,KKderg,AKA,AKAderg,AKAderx)
7440 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7441 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7442 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7447 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7449 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7452 cd if (lprn) write (2,*) 'In kernel'
7454 cd if (lprn) write (2,*) 'kkk=',kkk
7456 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7457 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7459 cd write (2,*) 'lll=',lll
7460 cd write (2,*) 'iii=1'
7462 cd write (2,'(3(2f10.5),5x)')
7463 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7466 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7467 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7469 cd write (2,*) 'lll=',lll
7470 cd write (2,*) 'iii=2'
7472 cd write (2,'(3(2f10.5),5x)')
7473 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7480 C---------------------------------------------------------------------------
7481 double precision function eello4(i,j,k,l,jj,kk)
7482 implicit real*8 (a-h,o-z)
7483 include 'DIMENSIONS'
7484 include 'COMMON.IOUNITS'
7485 include 'COMMON.CHAIN'
7486 include 'COMMON.DERIV'
7487 include 'COMMON.INTERACT'
7488 include 'COMMON.CONTACTS'
7489 include 'COMMON.TORSION'
7490 include 'COMMON.VAR'
7491 include 'COMMON.GEO'
7492 double precision pizda(2,2),ggg1(3),ggg2(3)
7493 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7497 cd print *,'eello4:',i,j,k,l,jj,kk
7498 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7499 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7500 cold eij=facont_hb(jj,i)
7501 cold ekl=facont_hb(kk,k)
7503 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7504 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7505 gcorr_loc(k-1)=gcorr_loc(k-1)
7506 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7508 gcorr_loc(l-1)=gcorr_loc(l-1)
7509 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7511 gcorr_loc(j-1)=gcorr_loc(j-1)
7512 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7517 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7518 & -EAEAderx(2,2,lll,kkk,iii,1)
7519 cd derx(lll,kkk,iii)=0.0d0
7523 cd gcorr_loc(l-1)=0.0d0
7524 cd gcorr_loc(j-1)=0.0d0
7525 cd gcorr_loc(k-1)=0.0d0
7527 cd write (iout,*)'Contacts have occurred for peptide groups',
7528 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7529 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7530 if (j.lt.nres-1) then
7537 if (l.lt.nres-1) then
7545 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7546 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7547 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7548 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7549 cgrad ghalf=0.5d0*ggg1(ll)
7550 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7551 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7552 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7553 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7554 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7555 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7556 cgrad ghalf=0.5d0*ggg2(ll)
7557 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7558 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7559 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7560 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7561 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7562 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7566 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7571 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7576 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7581 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7585 cd write (2,*) iii,gcorr_loc(iii)
7588 cd write (2,*) 'ekont',ekont
7589 cd write (iout,*) 'eello4',ekont*eel4
7592 C---------------------------------------------------------------------------
7593 double precision function eello5(i,j,k,l,jj,kk)
7594 implicit real*8 (a-h,o-z)
7595 include 'DIMENSIONS'
7596 include 'COMMON.IOUNITS'
7597 include 'COMMON.CHAIN'
7598 include 'COMMON.DERIV'
7599 include 'COMMON.INTERACT'
7600 include 'COMMON.CONTACTS'
7601 include 'COMMON.TORSION'
7602 include 'COMMON.VAR'
7603 include 'COMMON.GEO'
7604 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7605 double precision ggg1(3),ggg2(3)
7606 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7611 C /l\ / \ \ / \ / \ / C
7612 C / \ / \ \ / \ / \ / C
7613 C j| o |l1 | o | o| o | | o |o C
7614 C \ |/k\| |/ \| / |/ \| |/ \| C
7615 C \i/ \ / \ / / \ / \ C
7617 C (I) (II) (III) (IV) C
7619 C eello5_1 eello5_2 eello5_3 eello5_4 C
7621 C Antiparallel chains C
7624 C /j\ / \ \ / \ / \ / C
7625 C / \ / \ \ / \ / \ / C
7626 C j1| o |l | o | o| o | | o |o C
7627 C \ |/k\| |/ \| / |/ \| |/ \| C
7628 C \i/ \ / \ / / \ / \ C
7630 C (I) (II) (III) (IV) C
7632 C eello5_1 eello5_2 eello5_3 eello5_4 C
7634 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7636 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7637 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7642 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7644 itk=itortyp(itype(k))
7645 itl=itortyp(itype(l))
7646 itj=itortyp(itype(j))
7651 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7652 cd & eel5_3_num,eel5_4_num)
7656 derx(lll,kkk,iii)=0.0d0
7660 cd eij=facont_hb(jj,i)
7661 cd ekl=facont_hb(kk,k)
7663 cd write (iout,*)'Contacts have occurred for peptide groups',
7664 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7666 C Contribution from the graph I.
7667 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7668 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7669 call transpose2(EUg(1,1,k),auxmat(1,1))
7670 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7671 vv(1)=pizda(1,1)-pizda(2,2)
7672 vv(2)=pizda(1,2)+pizda(2,1)
7673 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7674 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7675 C Explicit gradient in virtual-dihedral angles.
7676 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7677 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7678 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7679 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7680 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7681 vv(1)=pizda(1,1)-pizda(2,2)
7682 vv(2)=pizda(1,2)+pizda(2,1)
7683 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7684 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7685 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7686 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7687 vv(1)=pizda(1,1)-pizda(2,2)
7688 vv(2)=pizda(1,2)+pizda(2,1)
7690 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7691 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7692 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7694 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7695 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7696 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7698 C Cartesian gradient
7702 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7704 vv(1)=pizda(1,1)-pizda(2,2)
7705 vv(2)=pizda(1,2)+pizda(2,1)
7706 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7707 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7708 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7714 C Contribution from graph II
7715 call transpose2(EE(1,1,itk),auxmat(1,1))
7716 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7717 vv(1)=pizda(1,1)+pizda(2,2)
7718 vv(2)=pizda(2,1)-pizda(1,2)
7719 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7720 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7721 C Explicit gradient in virtual-dihedral angles.
7722 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7723 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7724 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7725 vv(1)=pizda(1,1)+pizda(2,2)
7726 vv(2)=pizda(2,1)-pizda(1,2)
7728 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7729 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7730 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7732 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7733 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7734 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7736 C Cartesian gradient
7740 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7742 vv(1)=pizda(1,1)+pizda(2,2)
7743 vv(2)=pizda(2,1)-pizda(1,2)
7744 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7745 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7746 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7754 C Parallel orientation
7755 C Contribution from graph III
7756 call transpose2(EUg(1,1,l),auxmat(1,1))
7757 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7758 vv(1)=pizda(1,1)-pizda(2,2)
7759 vv(2)=pizda(1,2)+pizda(2,1)
7760 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7761 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7762 C Explicit gradient in virtual-dihedral angles.
7763 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7764 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7765 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7766 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7767 vv(1)=pizda(1,1)-pizda(2,2)
7768 vv(2)=pizda(1,2)+pizda(2,1)
7769 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7770 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7771 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7772 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7773 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7774 vv(1)=pizda(1,1)-pizda(2,2)
7775 vv(2)=pizda(1,2)+pizda(2,1)
7776 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7777 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7778 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7779 C Cartesian gradient
7783 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7785 vv(1)=pizda(1,1)-pizda(2,2)
7786 vv(2)=pizda(1,2)+pizda(2,1)
7787 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7788 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7789 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7794 C Contribution from graph IV
7796 call transpose2(EE(1,1,itl),auxmat(1,1))
7797 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7798 vv(1)=pizda(1,1)+pizda(2,2)
7799 vv(2)=pizda(2,1)-pizda(1,2)
7800 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7801 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7802 C Explicit gradient in virtual-dihedral angles.
7803 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7804 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7805 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7806 vv(1)=pizda(1,1)+pizda(2,2)
7807 vv(2)=pizda(2,1)-pizda(1,2)
7808 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7809 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7810 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7811 C Cartesian gradient
7815 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7817 vv(1)=pizda(1,1)+pizda(2,2)
7818 vv(2)=pizda(2,1)-pizda(1,2)
7819 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7820 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7821 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7826 C Antiparallel orientation
7827 C Contribution from graph III
7829 call transpose2(EUg(1,1,j),auxmat(1,1))
7830 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7831 vv(1)=pizda(1,1)-pizda(2,2)
7832 vv(2)=pizda(1,2)+pizda(2,1)
7833 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7834 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7835 C Explicit gradient in virtual-dihedral angles.
7836 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7837 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7838 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7839 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7840 vv(1)=pizda(1,1)-pizda(2,2)
7841 vv(2)=pizda(1,2)+pizda(2,1)
7842 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7843 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7844 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7845 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7846 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7847 vv(1)=pizda(1,1)-pizda(2,2)
7848 vv(2)=pizda(1,2)+pizda(2,1)
7849 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7850 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7851 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7852 C Cartesian gradient
7856 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7858 vv(1)=pizda(1,1)-pizda(2,2)
7859 vv(2)=pizda(1,2)+pizda(2,1)
7860 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7861 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7862 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7867 C Contribution from graph IV
7869 call transpose2(EE(1,1,itj),auxmat(1,1))
7870 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7871 vv(1)=pizda(1,1)+pizda(2,2)
7872 vv(2)=pizda(2,1)-pizda(1,2)
7873 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7874 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7875 C Explicit gradient in virtual-dihedral angles.
7876 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7877 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7878 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7879 vv(1)=pizda(1,1)+pizda(2,2)
7880 vv(2)=pizda(2,1)-pizda(1,2)
7881 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7882 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7883 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7884 C Cartesian gradient
7888 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7890 vv(1)=pizda(1,1)+pizda(2,2)
7891 vv(2)=pizda(2,1)-pizda(1,2)
7892 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7893 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7894 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7900 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7901 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7902 cd write (2,*) 'ijkl',i,j,k,l
7903 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7904 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7906 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7907 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7908 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7909 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7910 if (j.lt.nres-1) then
7917 if (l.lt.nres-1) then
7927 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7928 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7929 C summed up outside the subrouine as for the other subroutines
7930 C handling long-range interactions. The old code is commented out
7931 C with "cgrad" to keep track of changes.
7933 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7934 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7935 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7936 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7937 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7938 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7939 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7940 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7941 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7942 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7944 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7945 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7946 cgrad ghalf=0.5d0*ggg1(ll)
7948 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7949 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7950 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7951 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7952 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7953 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7954 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7955 cgrad ghalf=0.5d0*ggg2(ll)
7957 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7958 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7959 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7960 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7961 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7962 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7967 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7968 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7973 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7974 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7980 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7985 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7989 cd write (2,*) iii,g_corr5_loc(iii)
7992 cd write (2,*) 'ekont',ekont
7993 cd write (iout,*) 'eello5',ekont*eel5
7996 c--------------------------------------------------------------------------
7997 double precision function eello6(i,j,k,l,jj,kk)
7998 implicit real*8 (a-h,o-z)
7999 include 'DIMENSIONS'
8000 include 'COMMON.IOUNITS'
8001 include 'COMMON.CHAIN'
8002 include 'COMMON.DERIV'
8003 include 'COMMON.INTERACT'
8004 include 'COMMON.CONTACTS'
8005 include 'COMMON.TORSION'
8006 include 'COMMON.VAR'
8007 include 'COMMON.GEO'
8008 include 'COMMON.FFIELD'
8009 double precision ggg1(3),ggg2(3)
8010 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8015 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8023 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8024 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8028 derx(lll,kkk,iii)=0.0d0
8032 cd eij=facont_hb(jj,i)
8033 cd ekl=facont_hb(kk,k)
8039 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8040 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8041 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8042 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8043 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8044 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8046 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8047 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8048 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8049 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8050 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8051 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8055 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8057 C If turn contributions are considered, they will be handled separately.
8058 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8059 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8060 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8061 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8062 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8063 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8064 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8066 if (j.lt.nres-1) then
8073 if (l.lt.nres-1) then
8081 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8082 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8083 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8084 cgrad ghalf=0.5d0*ggg1(ll)
8086 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8087 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8088 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8089 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8090 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8091 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8092 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8093 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8094 cgrad ghalf=0.5d0*ggg2(ll)
8095 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8097 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8098 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8099 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8100 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8101 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8102 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8107 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8108 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8113 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8114 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8120 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8125 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8129 cd write (2,*) iii,g_corr6_loc(iii)
8132 cd write (2,*) 'ekont',ekont
8133 cd write (iout,*) 'eello6',ekont*eel6
8136 c--------------------------------------------------------------------------
8137 double precision function eello6_graph1(i,j,k,l,imat,swap)
8138 implicit real*8 (a-h,o-z)
8139 include 'DIMENSIONS'
8140 include 'COMMON.IOUNITS'
8141 include 'COMMON.CHAIN'
8142 include 'COMMON.DERIV'
8143 include 'COMMON.INTERACT'
8144 include 'COMMON.CONTACTS'
8145 include 'COMMON.TORSION'
8146 include 'COMMON.VAR'
8147 include 'COMMON.GEO'
8148 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8152 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8154 C Parallel Antiparallel
8160 C \ j|/k\| / \ |/k\|l /
8165 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8166 itk=itortyp(itype(k))
8167 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8168 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8169 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8170 call transpose2(EUgC(1,1,k),auxmat(1,1))
8171 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8172 vv1(1)=pizda1(1,1)-pizda1(2,2)
8173 vv1(2)=pizda1(1,2)+pizda1(2,1)
8174 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8175 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8176 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8177 s5=scalar2(vv(1),Dtobr2(1,i))
8178 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8179 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8180 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8181 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8182 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8183 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8184 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8185 & +scalar2(vv(1),Dtobr2der(1,i)))
8186 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8187 vv1(1)=pizda1(1,1)-pizda1(2,2)
8188 vv1(2)=pizda1(1,2)+pizda1(2,1)
8189 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8190 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8192 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8193 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8194 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8195 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8196 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8198 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8199 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8200 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8201 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8202 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8204 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8205 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8206 vv1(1)=pizda1(1,1)-pizda1(2,2)
8207 vv1(2)=pizda1(1,2)+pizda1(2,1)
8208 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8209 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8210 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8211 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8220 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8221 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8222 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8223 call transpose2(EUgC(1,1,k),auxmat(1,1))
8224 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8226 vv1(1)=pizda1(1,1)-pizda1(2,2)
8227 vv1(2)=pizda1(1,2)+pizda1(2,1)
8228 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8229 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8230 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8231 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8232 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8233 s5=scalar2(vv(1),Dtobr2(1,i))
8234 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8240 c----------------------------------------------------------------------------
8241 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8242 implicit real*8 (a-h,o-z)
8243 include 'DIMENSIONS'
8244 include 'COMMON.IOUNITS'
8245 include 'COMMON.CHAIN'
8246 include 'COMMON.DERIV'
8247 include 'COMMON.INTERACT'
8248 include 'COMMON.CONTACTS'
8249 include 'COMMON.TORSION'
8250 include 'COMMON.VAR'
8251 include 'COMMON.GEO'
8253 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8254 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8257 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8259 C Parallel Antiparallel C
8265 C \ j|/k\| \ |/k\|l C
8270 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8271 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8272 C AL 7/4/01 s1 would occur in the sixth-order moment,
8273 C but not in a cluster cumulant
8275 s1=dip(1,jj,i)*dip(1,kk,k)
8277 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8278 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8279 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8280 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8281 call transpose2(EUg(1,1,k),auxmat(1,1))
8282 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8283 vv(1)=pizda(1,1)-pizda(2,2)
8284 vv(2)=pizda(1,2)+pizda(2,1)
8285 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8286 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8288 eello6_graph2=-(s1+s2+s3+s4)
8290 eello6_graph2=-(s2+s3+s4)
8293 C Derivatives in gamma(i-1)
8296 s1=dipderg(1,jj,i)*dip(1,kk,k)
8298 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8299 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8300 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8301 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8303 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8305 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8307 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8309 C Derivatives in gamma(k-1)
8311 s1=dip(1,jj,i)*dipderg(1,kk,k)
8313 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8314 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8315 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8316 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8317 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8318 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8319 vv(1)=pizda(1,1)-pizda(2,2)
8320 vv(2)=pizda(1,2)+pizda(2,1)
8321 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8323 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8325 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8327 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8328 C Derivatives in gamma(j-1) or gamma(l-1)
8331 s1=dipderg(3,jj,i)*dip(1,kk,k)
8333 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8334 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8335 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8336 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8337 vv(1)=pizda(1,1)-pizda(2,2)
8338 vv(2)=pizda(1,2)+pizda(2,1)
8339 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8342 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8344 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8347 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8348 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8350 C Derivatives in gamma(l-1) or gamma(j-1)
8353 s1=dip(1,jj,i)*dipderg(3,kk,k)
8355 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8356 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8357 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8358 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8359 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8360 vv(1)=pizda(1,1)-pizda(2,2)
8361 vv(2)=pizda(1,2)+pizda(2,1)
8362 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8365 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8367 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8370 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8371 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8373 C Cartesian derivatives.
8375 write (2,*) 'In eello6_graph2'
8377 write (2,*) 'iii=',iii
8379 write (2,*) 'kkk=',kkk
8381 write (2,'(3(2f10.5),5x)')
8382 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8392 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8394 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8397 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8399 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8400 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8402 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8403 call transpose2(EUg(1,1,k),auxmat(1,1))
8404 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8406 vv(1)=pizda(1,1)-pizda(2,2)
8407 vv(2)=pizda(1,2)+pizda(2,1)
8408 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8409 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8411 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8413 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8416 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8418 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8425 c----------------------------------------------------------------------------
8426 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8427 implicit real*8 (a-h,o-z)
8428 include 'DIMENSIONS'
8429 include 'COMMON.IOUNITS'
8430 include 'COMMON.CHAIN'
8431 include 'COMMON.DERIV'
8432 include 'COMMON.INTERACT'
8433 include 'COMMON.CONTACTS'
8434 include 'COMMON.TORSION'
8435 include 'COMMON.VAR'
8436 include 'COMMON.GEO'
8437 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8439 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8441 C Parallel Antiparallel C
8447 C j|/k\| / |/k\|l / C
8452 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8454 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8455 C energy moment and not to the cluster cumulant.
8456 iti=itortyp(itype(i))
8457 if (j.lt.nres-1) then
8458 itj1=itortyp(itype(j+1))
8462 itk=itortyp(itype(k))
8463 itk1=itortyp(itype(k+1))
8464 if (l.lt.nres-1) then
8465 itl1=itortyp(itype(l+1))
8470 s1=dip(4,jj,i)*dip(4,kk,k)
8472 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8473 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8474 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8475 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8476 call transpose2(EE(1,1,itk),auxmat(1,1))
8477 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8478 vv(1)=pizda(1,1)+pizda(2,2)
8479 vv(2)=pizda(2,1)-pizda(1,2)
8480 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8481 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8482 cd & "sum",-(s2+s3+s4)
8484 eello6_graph3=-(s1+s2+s3+s4)
8486 eello6_graph3=-(s2+s3+s4)
8489 C Derivatives in gamma(k-1)
8490 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8491 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8492 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8493 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8494 C Derivatives in gamma(l-1)
8495 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8496 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8497 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8498 vv(1)=pizda(1,1)+pizda(2,2)
8499 vv(2)=pizda(2,1)-pizda(1,2)
8500 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8501 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8502 C Cartesian derivatives.
8508 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8510 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8513 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8515 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8516 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8518 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8519 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8521 vv(1)=pizda(1,1)+pizda(2,2)
8522 vv(2)=pizda(2,1)-pizda(1,2)
8523 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8525 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8527 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8530 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8532 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8534 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8540 c----------------------------------------------------------------------------
8541 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8542 implicit real*8 (a-h,o-z)
8543 include 'DIMENSIONS'
8544 include 'COMMON.IOUNITS'
8545 include 'COMMON.CHAIN'
8546 include 'COMMON.DERIV'
8547 include 'COMMON.INTERACT'
8548 include 'COMMON.CONTACTS'
8549 include 'COMMON.TORSION'
8550 include 'COMMON.VAR'
8551 include 'COMMON.GEO'
8552 include 'COMMON.FFIELD'
8553 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8554 & auxvec1(2),auxmat1(2,2)
8556 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8558 C Parallel Antiparallel C
8564 C \ j|/k\| \ |/k\|l C
8569 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8571 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8572 C energy moment and not to the cluster cumulant.
8573 cd write (2,*) 'eello_graph4: wturn6',wturn6
8574 iti=itortyp(itype(i))
8575 itj=itortyp(itype(j))
8576 if (j.lt.nres-1) then
8577 itj1=itortyp(itype(j+1))
8581 itk=itortyp(itype(k))
8582 if (k.lt.nres-1) then
8583 itk1=itortyp(itype(k+1))
8587 itl=itortyp(itype(l))
8588 if (l.lt.nres-1) then
8589 itl1=itortyp(itype(l+1))
8593 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8594 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8595 cd & ' itl',itl,' itl1',itl1
8598 s1=dip(3,jj,i)*dip(3,kk,k)
8600 s1=dip(2,jj,j)*dip(2,kk,l)
8603 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8604 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8606 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8607 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8609 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8610 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8612 call transpose2(EUg(1,1,k),auxmat(1,1))
8613 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8614 vv(1)=pizda(1,1)-pizda(2,2)
8615 vv(2)=pizda(2,1)+pizda(1,2)
8616 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8617 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8619 eello6_graph4=-(s1+s2+s3+s4)
8621 eello6_graph4=-(s2+s3+s4)
8623 C Derivatives in gamma(i-1)
8627 s1=dipderg(2,jj,i)*dip(3,kk,k)
8629 s1=dipderg(4,jj,j)*dip(2,kk,l)
8632 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8634 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8635 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8637 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8638 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8640 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8641 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8642 cd write (2,*) 'turn6 derivatives'
8644 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8646 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8650 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8652 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8656 C Derivatives in gamma(k-1)
8659 s1=dip(3,jj,i)*dipderg(2,kk,k)
8661 s1=dip(2,jj,j)*dipderg(4,kk,l)
8664 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8665 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8667 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8668 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8670 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8671 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8673 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8674 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8675 vv(1)=pizda(1,1)-pizda(2,2)
8676 vv(2)=pizda(2,1)+pizda(1,2)
8677 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8678 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8680 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8682 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8686 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8688 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8691 C Derivatives in gamma(j-1) or gamma(l-1)
8692 if (l.eq.j+1 .and. l.gt.1) then
8693 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8694 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8695 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8696 vv(1)=pizda(1,1)-pizda(2,2)
8697 vv(2)=pizda(2,1)+pizda(1,2)
8698 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8699 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8700 else if (j.gt.1) then
8701 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8702 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8703 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8704 vv(1)=pizda(1,1)-pizda(2,2)
8705 vv(2)=pizda(2,1)+pizda(1,2)
8706 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8707 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8708 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8710 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8713 C Cartesian derivatives.
8720 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8722 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8726 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8728 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8732 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8734 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8736 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8737 & b1(1,itj1),auxvec(1))
8738 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8740 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8741 & b1(1,itl1),auxvec(1))
8742 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8744 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8746 vv(1)=pizda(1,1)-pizda(2,2)
8747 vv(2)=pizda(2,1)+pizda(1,2)
8748 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8750 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8752 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8755 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8758 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8761 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8763 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8765 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8769 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8771 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8774 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8776 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8784 c----------------------------------------------------------------------------
8785 double precision function eello_turn6(i,jj,kk)
8786 implicit real*8 (a-h,o-z)
8787 include 'DIMENSIONS'
8788 include 'COMMON.IOUNITS'
8789 include 'COMMON.CHAIN'
8790 include 'COMMON.DERIV'
8791 include 'COMMON.INTERACT'
8792 include 'COMMON.CONTACTS'
8793 include 'COMMON.TORSION'
8794 include 'COMMON.VAR'
8795 include 'COMMON.GEO'
8796 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8797 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8799 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8800 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8801 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8802 C the respective energy moment and not to the cluster cumulant.
8811 iti=itortyp(itype(i))
8812 itk=itortyp(itype(k))
8813 itk1=itortyp(itype(k+1))
8814 itl=itortyp(itype(l))
8815 itj=itortyp(itype(j))
8816 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8817 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8818 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8823 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8825 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8829 derx_turn(lll,kkk,iii)=0.0d0
8836 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8838 cd write (2,*) 'eello6_5',eello6_5
8840 call transpose2(AEA(1,1,1),auxmat(1,1))
8841 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8842 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8843 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8845 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8846 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8847 s2 = scalar2(b1(1,itk),vtemp1(1))
8849 call transpose2(AEA(1,1,2),atemp(1,1))
8850 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8851 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8852 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8854 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8855 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8856 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8858 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8859 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8860 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8861 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8862 ss13 = scalar2(b1(1,itk),vtemp4(1))
8863 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8865 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8871 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8872 C Derivatives in gamma(i+2)
8876 call transpose2(AEA(1,1,1),auxmatd(1,1))
8877 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8878 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8879 call transpose2(AEAderg(1,1,2),atempd(1,1))
8880 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8881 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8883 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8884 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8885 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8891 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8892 C Derivatives in gamma(i+3)
8894 call transpose2(AEA(1,1,1),auxmatd(1,1))
8895 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8896 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8897 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8899 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8900 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8901 s2d = scalar2(b1(1,itk),vtemp1d(1))
8903 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8904 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8906 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8908 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8909 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8910 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8918 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8919 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8921 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8922 & -0.5d0*ekont*(s2d+s12d)
8924 C Derivatives in gamma(i+4)
8925 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8926 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8927 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8929 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8930 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8931 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8939 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8941 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8943 C Derivatives in gamma(i+5)
8945 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8946 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8947 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8949 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8950 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8951 s2d = scalar2(b1(1,itk),vtemp1d(1))
8953 call transpose2(AEA(1,1,2),atempd(1,1))
8954 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8955 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8957 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8958 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8960 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8961 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8962 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8970 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8971 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8973 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8974 & -0.5d0*ekont*(s2d+s12d)
8976 C Cartesian derivatives
8981 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8982 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8983 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8985 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8986 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8988 s2d = scalar2(b1(1,itk),vtemp1d(1))
8990 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8991 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8992 s8d = -(atempd(1,1)+atempd(2,2))*
8993 & scalar2(cc(1,1,itl),vtemp2(1))
8995 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8997 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8998 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9005 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9008 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9012 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9013 & - 0.5d0*(s8d+s12d)
9015 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9024 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9026 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9027 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9028 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9029 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9030 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9032 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9033 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9034 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9038 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9039 cd & 16*eel_turn6_num
9041 if (j.lt.nres-1) then
9048 if (l.lt.nres-1) then
9056 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9057 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9058 cgrad ghalf=0.5d0*ggg1(ll)
9060 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9061 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9062 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9063 & +ekont*derx_turn(ll,2,1)
9064 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9065 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9066 & +ekont*derx_turn(ll,4,1)
9067 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9068 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9069 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9070 cgrad ghalf=0.5d0*ggg2(ll)
9072 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9073 & +ekont*derx_turn(ll,2,2)
9074 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9075 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9076 & +ekont*derx_turn(ll,4,2)
9077 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9078 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9079 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9084 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9089 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9095 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9100 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9104 cd write (2,*) iii,g_corr6_loc(iii)
9106 eello_turn6=ekont*eel_turn6
9107 cd write (2,*) 'ekont',ekont
9108 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9112 C-----------------------------------------------------------------------------
9113 double precision function scalar(u,v)
9114 !DIR$ INLINEALWAYS scalar
9116 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9119 double precision u(3),v(3)
9120 cd double precision sc
9128 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9131 crc-------------------------------------------------
9132 SUBROUTINE MATVEC2(A1,V1,V2)
9133 !DIR$ INLINEALWAYS MATVEC2
9135 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9137 implicit real*8 (a-h,o-z)
9138 include 'DIMENSIONS'
9139 DIMENSION A1(2,2),V1(2),V2(2)
9143 c 3 VI=VI+A1(I,K)*V1(K)
9147 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9148 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9153 C---------------------------------------
9154 SUBROUTINE MATMAT2(A1,A2,A3)
9156 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9158 implicit real*8 (a-h,o-z)
9159 include 'DIMENSIONS'
9160 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9161 c DIMENSION AI3(2,2)
9165 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9171 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9172 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9173 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9174 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9182 c-------------------------------------------------------------------------
9183 double precision function scalar2(u,v)
9184 !DIR$ INLINEALWAYS scalar2
9186 double precision u(2),v(2)
9189 scalar2=u(1)*v(1)+u(2)*v(2)
9193 C-----------------------------------------------------------------------------
9195 subroutine transpose2(a,at)
9196 !DIR$ INLINEALWAYS transpose2
9198 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9201 double precision a(2,2),at(2,2)
9208 c--------------------------------------------------------------------------
9209 subroutine transpose(n,a,at)
9212 double precision a(n,n),at(n,n)
9220 C---------------------------------------------------------------------------
9221 subroutine prodmat3(a1,a2,kk,transp,prod)
9222 !DIR$ INLINEALWAYS prodmat3
9224 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9228 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9230 crc double precision auxmat(2,2),prod_(2,2)
9233 crc call transpose2(kk(1,1),auxmat(1,1))
9234 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9235 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9237 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9238 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9239 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9240 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9241 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9242 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9243 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9244 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9247 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9248 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9250 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9251 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9252 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9253 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9254 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9255 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9256 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9257 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9260 c call transpose2(a2(1,1),a2t(1,1))
9263 crc print *,((prod_(i,j),i=1,2),j=1,2)
9264 crc print *,((prod(i,j),i=1,2),j=1,2)