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)
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) then
1683 write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
1686 C Calculate gradient components.
1687 e1=e1*eps1*eps2rt**2*eps3rt**2
1688 fac=-expon*(e1+evdwij)*rij_shift
1692 C Calculate the radial part of the gradient
1696 C Calculate angular part of the gradient.
1698 if (bb(itypi,itypj).gt.0) then
1710 c write (iout,*) "Number of loop steps in EGB:",ind
1711 cccc energy_dec=.false.
1714 C-----------------------------------------------------------------------------
1715 subroutine egbv(evdw,evdw_p,evdw_m)
1717 C This subroutine calculates the interaction energy of nonbonded side chains
1718 C assuming the Gay-Berne-Vorobjev potential of interaction.
1720 implicit real*8 (a-h,o-z)
1721 include 'DIMENSIONS'
1722 include 'COMMON.GEO'
1723 include 'COMMON.VAR'
1724 include 'COMMON.LOCAL'
1725 include 'COMMON.CHAIN'
1726 include 'COMMON.DERIV'
1727 include 'COMMON.NAMES'
1728 include 'COMMON.INTERACT'
1729 include 'COMMON.IOUNITS'
1730 include 'COMMON.CALC'
1731 common /srutu/ icall
1734 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1737 c if (icall.eq.0) lprn=.true.
1739 do i=iatsc_s,iatsc_e
1745 dxi=dc_norm(1,nres+i)
1746 dyi=dc_norm(2,nres+i)
1747 dzi=dc_norm(3,nres+i)
1748 c dsci_inv=dsc_inv(itypi)
1749 dsci_inv=vbld_inv(i+nres)
1751 C Calculate SC interaction energy.
1753 do iint=1,nint_gr(i)
1754 do j=istart(i,iint),iend(i,iint)
1757 c dscj_inv=dsc_inv(itypj)
1758 dscj_inv=vbld_inv(j+nres)
1759 sig0ij=sigma(itypi,itypj)
1760 r0ij=r0(itypi,itypj)
1761 chi1=chi(itypi,itypj)
1762 chi2=chi(itypj,itypi)
1769 alf12=0.5D0*(alf1+alf2)
1770 C For diagnostics only!!!
1783 dxj=dc_norm(1,nres+j)
1784 dyj=dc_norm(2,nres+j)
1785 dzj=dc_norm(3,nres+j)
1786 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1788 C Calculate angle-dependent terms of energy and contributions to their
1792 sig=sig0ij*dsqrt(sigsq)
1793 rij_shift=1.0D0/rij-sig+r0ij
1794 C I hate to put IF's in the loops, but here don't have another choice!!!!
1795 if (rij_shift.le.0.0D0) then
1800 c---------------------------------------------------------------
1801 rij_shift=1.0D0/rij_shift
1802 fac=rij_shift**expon
1803 e1=fac*fac*aa(itypi,itypj)
1804 e2=fac*bb(itypi,itypj)
1805 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1806 eps2der=evdwij*eps3rt
1807 eps3der=evdwij*eps2rt
1808 fac_augm=rrij**expon
1809 e_augm=augm(itypi,itypj)*fac_augm
1810 evdwij=evdwij*eps2rt*eps3rt
1812 if (bb(itypi,itypj).gt.0) then
1813 evdw_p=evdw_p+evdwij+e_augm
1815 evdw_m=evdw_m+evdwij+e_augm
1818 evdw=evdw+evdwij+e_augm
1821 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1822 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1823 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1824 & restyp(itypi),i,restyp(itypj),j,
1825 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1826 & chi1,chi2,chip1,chip2,
1827 & eps1,eps2rt**2,eps3rt**2,
1828 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1831 C Calculate gradient components.
1832 e1=e1*eps1*eps2rt**2*eps3rt**2
1833 fac=-expon*(e1+evdwij)*rij_shift
1835 fac=rij*fac-2*expon*rrij*e_augm
1836 C Calculate the radial part of the gradient
1840 C Calculate angular part of the gradient.
1842 if (bb(itypi,itypj).gt.0) then
1854 C-----------------------------------------------------------------------------
1855 subroutine sc_angular
1856 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1857 C om12. Called by ebp, egb, and egbv.
1859 include 'COMMON.CALC'
1860 include 'COMMON.IOUNITS'
1864 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1865 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1866 om12=dxi*dxj+dyi*dyj+dzi*dzj
1868 C Calculate eps1(om12) and its derivative in om12
1869 faceps1=1.0D0-om12*chiom12
1870 faceps1_inv=1.0D0/faceps1
1871 eps1=dsqrt(faceps1_inv)
1872 C Following variable is eps1*deps1/dom12
1873 eps1_om12=faceps1_inv*chiom12
1878 c write (iout,*) "om12",om12," eps1",eps1
1879 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1884 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1885 sigsq=1.0D0-facsig*faceps1_inv
1886 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1887 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1888 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1894 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1895 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1897 C Calculate eps2 and its derivatives in om1, om2, and om12.
1900 chipom12=chip12*om12
1901 facp=1.0D0-om12*chipom12
1903 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1904 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1905 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1906 C Following variable is the square root of eps2
1907 eps2rt=1.0D0-facp1*facp_inv
1908 C Following three variables are the derivatives of the square root of eps
1909 C in om1, om2, and om12.
1910 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1911 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1912 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1913 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1914 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1915 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1916 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1917 c & " eps2rt_om12",eps2rt_om12
1918 C Calculate whole angle-dependent part of epsilon and contributions
1919 C to its derivatives
1923 C----------------------------------------------------------------------------
1924 subroutine sc_grad_T
1925 implicit real*8 (a-h,o-z)
1926 include 'DIMENSIONS'
1927 include 'COMMON.CHAIN'
1928 include 'COMMON.DERIV'
1929 include 'COMMON.CALC'
1930 include 'COMMON.IOUNITS'
1931 double precision dcosom1(3),dcosom2(3)
1932 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1933 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1934 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1935 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1939 c eom12=evdwij*eps1_om12
1941 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1942 c & " sigder",sigder
1943 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1944 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1946 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1947 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1950 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1952 c write (iout,*) "gg",(gg(k),k=1,3)
1954 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1955 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1956 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1957 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1958 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1959 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1960 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1961 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1962 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1963 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1966 C Calculate the components of the gradient in DC and X
1970 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1974 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1975 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1980 C----------------------------------------------------------------------------
1982 implicit real*8 (a-h,o-z)
1983 include 'DIMENSIONS'
1984 include 'COMMON.CHAIN'
1985 include 'COMMON.DERIV'
1986 include 'COMMON.CALC'
1987 include 'COMMON.IOUNITS'
1988 double precision dcosom1(3),dcosom2(3)
1989 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1990 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1991 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1992 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1996 c eom12=evdwij*eps1_om12
1998 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1999 c & " sigder",sigder
2000 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2001 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2003 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2004 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2007 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2009 c write (iout,*) "gg",(gg(k),k=1,3)
2011 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2012 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2013 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2014 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2015 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2016 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2017 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2018 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2019 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2020 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2023 C Calculate the components of the gradient in DC and X
2027 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2031 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2032 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2036 C-----------------------------------------------------------------------
2037 subroutine e_softsphere(evdw)
2039 C This subroutine calculates the interaction energy of nonbonded side chains
2040 C assuming the LJ potential of interaction.
2042 implicit real*8 (a-h,o-z)
2043 include 'DIMENSIONS'
2044 parameter (accur=1.0d-10)
2045 include 'COMMON.GEO'
2046 include 'COMMON.VAR'
2047 include 'COMMON.LOCAL'
2048 include 'COMMON.CHAIN'
2049 include 'COMMON.DERIV'
2050 include 'COMMON.INTERACT'
2051 include 'COMMON.TORSION'
2052 include 'COMMON.SBRIDGE'
2053 include 'COMMON.NAMES'
2054 include 'COMMON.IOUNITS'
2055 include 'COMMON.CONTACTS'
2057 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2059 do i=iatsc_s,iatsc_e
2066 C Calculate SC interaction energy.
2068 do iint=1,nint_gr(i)
2069 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2070 cd & 'iend=',iend(i,iint)
2071 do j=istart(i,iint),iend(i,iint)
2076 rij=xj*xj+yj*yj+zj*zj
2077 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2078 r0ij=r0(itypi,itypj)
2080 c print *,i,j,r0ij,dsqrt(rij)
2081 if (rij.lt.r0ijsq) then
2082 evdwij=0.25d0*(rij-r0ijsq)**2
2090 C Calculate the components of the gradient in DC and X
2096 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2097 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2098 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2099 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2103 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2111 C--------------------------------------------------------------------------
2112 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2115 C Soft-sphere potential of p-p interaction
2117 implicit real*8 (a-h,o-z)
2118 include 'DIMENSIONS'
2119 include 'COMMON.CONTROL'
2120 include 'COMMON.IOUNITS'
2121 include 'COMMON.GEO'
2122 include 'COMMON.VAR'
2123 include 'COMMON.LOCAL'
2124 include 'COMMON.CHAIN'
2125 include 'COMMON.DERIV'
2126 include 'COMMON.INTERACT'
2127 include 'COMMON.CONTACTS'
2128 include 'COMMON.TORSION'
2129 include 'COMMON.VECTORS'
2130 include 'COMMON.FFIELD'
2132 cd write(iout,*) 'In EELEC_soft_sphere'
2139 do i=iatel_s,iatel_e
2143 xmedi=c(1,i)+0.5d0*dxi
2144 ymedi=c(2,i)+0.5d0*dyi
2145 zmedi=c(3,i)+0.5d0*dzi
2147 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2148 do j=ielstart(i),ielend(i)
2152 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2153 r0ij=rpp(iteli,itelj)
2158 xj=c(1,j)+0.5D0*dxj-xmedi
2159 yj=c(2,j)+0.5D0*dyj-ymedi
2160 zj=c(3,j)+0.5D0*dzj-zmedi
2161 rij=xj*xj+yj*yj+zj*zj
2162 if (rij.lt.r0ijsq) then
2163 evdw1ij=0.25d0*(rij-r0ijsq)**2
2171 C Calculate contributions to the Cartesian gradient.
2177 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2178 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2181 * Loop over residues i+1 thru j-1.
2185 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2190 cgrad do i=nnt,nct-1
2192 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2194 cgrad do j=i+1,nct-1
2196 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2202 c------------------------------------------------------------------------------
2203 subroutine vec_and_deriv
2204 implicit real*8 (a-h,o-z)
2205 include 'DIMENSIONS'
2209 include 'COMMON.IOUNITS'
2210 include 'COMMON.GEO'
2211 include 'COMMON.VAR'
2212 include 'COMMON.LOCAL'
2213 include 'COMMON.CHAIN'
2214 include 'COMMON.VECTORS'
2215 include 'COMMON.SETUP'
2216 include 'COMMON.TIME1'
2217 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2218 C Compute the local reference systems. For reference system (i), the
2219 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2220 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2222 do i=ivec_start,ivec_end
2226 if (i.eq.nres-1) then
2227 C Case of the last full residue
2228 C Compute the Z-axis
2229 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2230 costh=dcos(pi-theta(nres))
2231 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2235 C Compute the derivatives of uz
2237 uzder(2,1,1)=-dc_norm(3,i-1)
2238 uzder(3,1,1)= dc_norm(2,i-1)
2239 uzder(1,2,1)= dc_norm(3,i-1)
2241 uzder(3,2,1)=-dc_norm(1,i-1)
2242 uzder(1,3,1)=-dc_norm(2,i-1)
2243 uzder(2,3,1)= dc_norm(1,i-1)
2246 uzder(2,1,2)= dc_norm(3,i)
2247 uzder(3,1,2)=-dc_norm(2,i)
2248 uzder(1,2,2)=-dc_norm(3,i)
2250 uzder(3,2,2)= dc_norm(1,i)
2251 uzder(1,3,2)= dc_norm(2,i)
2252 uzder(2,3,2)=-dc_norm(1,i)
2254 C Compute the Y-axis
2257 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2259 C Compute the derivatives of uy
2262 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2263 & -dc_norm(k,i)*dc_norm(j,i-1)
2264 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2266 uyder(j,j,1)=uyder(j,j,1)-costh
2267 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2272 uygrad(l,k,j,i)=uyder(l,k,j)
2273 uzgrad(l,k,j,i)=uzder(l,k,j)
2277 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2278 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2279 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2280 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2283 C Compute the Z-axis
2284 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2285 costh=dcos(pi-theta(i+2))
2286 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2290 C Compute the derivatives of uz
2292 uzder(2,1,1)=-dc_norm(3,i+1)
2293 uzder(3,1,1)= dc_norm(2,i+1)
2294 uzder(1,2,1)= dc_norm(3,i+1)
2296 uzder(3,2,1)=-dc_norm(1,i+1)
2297 uzder(1,3,1)=-dc_norm(2,i+1)
2298 uzder(2,3,1)= dc_norm(1,i+1)
2301 uzder(2,1,2)= dc_norm(3,i)
2302 uzder(3,1,2)=-dc_norm(2,i)
2303 uzder(1,2,2)=-dc_norm(3,i)
2305 uzder(3,2,2)= dc_norm(1,i)
2306 uzder(1,3,2)= dc_norm(2,i)
2307 uzder(2,3,2)=-dc_norm(1,i)
2309 C Compute the Y-axis
2312 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2314 C Compute the derivatives of uy
2317 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2318 & -dc_norm(k,i)*dc_norm(j,i+1)
2319 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2321 uyder(j,j,1)=uyder(j,j,1)-costh
2322 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2327 uygrad(l,k,j,i)=uyder(l,k,j)
2328 uzgrad(l,k,j,i)=uzder(l,k,j)
2332 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2333 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2334 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2335 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2339 vbld_inv_temp(1)=vbld_inv(i+1)
2340 if (i.lt.nres-1) then
2341 vbld_inv_temp(2)=vbld_inv(i+2)
2343 vbld_inv_temp(2)=vbld_inv(i)
2348 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2349 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2354 #if defined(PARVEC) && defined(MPI)
2355 if (nfgtasks1.gt.1) then
2357 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2358 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2359 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2360 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2361 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2363 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2364 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2366 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2367 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2368 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2369 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2370 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2371 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2372 time_gather=time_gather+MPI_Wtime()-time00
2374 c if (fg_rank.eq.0) then
2375 c write (iout,*) "Arrays UY and UZ"
2377 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2384 C-----------------------------------------------------------------------------
2385 subroutine check_vecgrad
2386 implicit real*8 (a-h,o-z)
2387 include 'DIMENSIONS'
2388 include 'COMMON.IOUNITS'
2389 include 'COMMON.GEO'
2390 include 'COMMON.VAR'
2391 include 'COMMON.LOCAL'
2392 include 'COMMON.CHAIN'
2393 include 'COMMON.VECTORS'
2394 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2395 dimension uyt(3,maxres),uzt(3,maxres)
2396 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2397 double precision delta /1.0d-7/
2400 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2401 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2402 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2403 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2404 cd & (dc_norm(if90,i),if90=1,3)
2405 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2406 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2407 cd write(iout,'(a)')
2413 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2414 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2427 cd write (iout,*) 'i=',i
2429 erij(k)=dc_norm(k,i)
2433 dc_norm(k,i)=erij(k)
2435 dc_norm(j,i)=dc_norm(j,i)+delta
2436 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2438 c dc_norm(k,i)=dc_norm(k,i)/fac
2440 c write (iout,*) (dc_norm(k,i),k=1,3)
2441 c write (iout,*) (erij(k),k=1,3)
2444 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2445 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2446 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2447 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2449 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2450 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2451 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2454 dc_norm(k,i)=erij(k)
2457 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2458 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2459 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2460 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2461 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2462 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2463 cd write (iout,'(a)')
2468 C--------------------------------------------------------------------------
2469 subroutine set_matrices
2470 implicit real*8 (a-h,o-z)
2471 include 'DIMENSIONS'
2474 include "COMMON.SETUP"
2476 integer status(MPI_STATUS_SIZE)
2478 include 'COMMON.IOUNITS'
2479 include 'COMMON.GEO'
2480 include 'COMMON.VAR'
2481 include 'COMMON.LOCAL'
2482 include 'COMMON.CHAIN'
2483 include 'COMMON.DERIV'
2484 include 'COMMON.INTERACT'
2485 include 'COMMON.CONTACTS'
2486 include 'COMMON.TORSION'
2487 include 'COMMON.VECTORS'
2488 include 'COMMON.FFIELD'
2489 double precision auxvec(2),auxmat(2,2)
2491 C Compute the virtual-bond-torsional-angle dependent quantities needed
2492 C to calculate the el-loc multibody terms of various order.
2495 do i=ivec_start+2,ivec_end+2
2499 if (i .lt. nres+1) then
2536 if (i .gt. 3 .and. i .lt. nres+1) then
2537 obrot_der(1,i-2)=-sin1
2538 obrot_der(2,i-2)= cos1
2539 Ugder(1,1,i-2)= sin1
2540 Ugder(1,2,i-2)=-cos1
2541 Ugder(2,1,i-2)=-cos1
2542 Ugder(2,2,i-2)=-sin1
2545 obrot2_der(1,i-2)=-dwasin2
2546 obrot2_der(2,i-2)= dwacos2
2547 Ug2der(1,1,i-2)= dwasin2
2548 Ug2der(1,2,i-2)=-dwacos2
2549 Ug2der(2,1,i-2)=-dwacos2
2550 Ug2der(2,2,i-2)=-dwasin2
2552 obrot_der(1,i-2)=0.0d0
2553 obrot_der(2,i-2)=0.0d0
2554 Ugder(1,1,i-2)=0.0d0
2555 Ugder(1,2,i-2)=0.0d0
2556 Ugder(2,1,i-2)=0.0d0
2557 Ugder(2,2,i-2)=0.0d0
2558 obrot2_der(1,i-2)=0.0d0
2559 obrot2_der(2,i-2)=0.0d0
2560 Ug2der(1,1,i-2)=0.0d0
2561 Ug2der(1,2,i-2)=0.0d0
2562 Ug2der(2,1,i-2)=0.0d0
2563 Ug2der(2,2,i-2)=0.0d0
2565 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2566 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2567 iti = itortyp(itype(i-2))
2571 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2572 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2573 iti1 = itortyp(itype(i-1))
2577 cd write (iout,*) '*******i',i,' iti1',iti
2578 cd write (iout,*) 'b1',b1(:,iti)
2579 cd write (iout,*) 'b2',b2(:,iti)
2580 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2581 c if (i .gt. iatel_s+2) then
2582 if (i .gt. nnt+2) then
2583 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2584 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2585 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2587 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2588 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2589 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2590 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2591 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2602 DtUg2(l,k,i-2)=0.0d0
2606 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2607 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2609 muder(k,i-2)=Ub2der(k,i-2)
2611 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2612 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2613 iti1 = itortyp(itype(i-1))
2618 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2620 cd write (iout,*) 'mu ',mu(:,i-2)
2621 cd write (iout,*) 'mu1',mu1(:,i-2)
2622 cd write (iout,*) 'mu2',mu2(:,i-2)
2623 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2625 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2626 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2627 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2628 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2629 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2630 C Vectors and matrices dependent on a single virtual-bond dihedral.
2631 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2632 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2633 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2634 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2635 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2636 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2637 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2638 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2639 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2642 C Matrices dependent on two consecutive virtual-bond dihedrals.
2643 C The order of matrices is from left to right.
2644 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2646 c do i=max0(ivec_start,2),ivec_end
2648 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2649 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2650 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2651 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2652 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2653 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2654 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2655 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2658 #if defined(MPI) && defined(PARMAT)
2660 c if (fg_rank.eq.0) then
2661 write (iout,*) "Arrays UG and UGDER before GATHER"
2663 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2664 & ((ug(l,k,i),l=1,2),k=1,2),
2665 & ((ugder(l,k,i),l=1,2),k=1,2)
2667 write (iout,*) "Arrays UG2 and UG2DER"
2669 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2670 & ((ug2(l,k,i),l=1,2),k=1,2),
2671 & ((ug2der(l,k,i),l=1,2),k=1,2)
2673 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2675 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2676 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2677 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2679 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2681 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2682 & costab(i),sintab(i),costab2(i),sintab2(i)
2684 write (iout,*) "Array MUDER"
2686 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2690 if (nfgtasks.gt.1) then
2692 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2693 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2694 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2696 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2697 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2699 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2700 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2702 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2703 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2705 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2706 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2708 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2709 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2711 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2712 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2714 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2715 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2716 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2717 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2718 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2719 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2720 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2721 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2722 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2723 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2724 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2725 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2726 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2728 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2731 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2734 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2735 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2737 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2738 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2740 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2741 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2743 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2744 & ivec_count(fg_rank1),
2745 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2747 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2748 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2750 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2751 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2753 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2754 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2756 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2757 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2759 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2760 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2762 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2763 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2765 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2766 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2768 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2769 & ivec_count(fg_rank1),
2770 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2772 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2773 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2775 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2776 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2778 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2779 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2781 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2782 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2784 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2785 & ivec_count(fg_rank1),
2786 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2788 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2789 & ivec_count(fg_rank1),
2790 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2792 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2793 & ivec_count(fg_rank1),
2794 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2795 & MPI_MAT2,FG_COMM1,IERR)
2796 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2797 & ivec_count(fg_rank1),
2798 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2799 & MPI_MAT2,FG_COMM1,IERR)
2802 c Passes matrix info through the ring
2805 if (irecv.lt.0) irecv=nfgtasks1-1
2808 if (inext.ge.nfgtasks1) inext=0
2810 c write (iout,*) "isend",isend," irecv",irecv
2812 lensend=lentyp(isend)
2813 lenrecv=lentyp(irecv)
2814 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2815 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2816 c & MPI_ROTAT1(lensend),inext,2200+isend,
2817 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2818 c & iprev,2200+irecv,FG_COMM,status,IERR)
2819 c write (iout,*) "Gather ROTAT1"
2821 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2822 c & MPI_ROTAT2(lensend),inext,3300+isend,
2823 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2824 c & iprev,3300+irecv,FG_COMM,status,IERR)
2825 c write (iout,*) "Gather ROTAT2"
2827 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2828 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2829 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2830 & iprev,4400+irecv,FG_COMM,status,IERR)
2831 c write (iout,*) "Gather ROTAT_OLD"
2833 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2834 & MPI_PRECOMP11(lensend),inext,5500+isend,
2835 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2836 & iprev,5500+irecv,FG_COMM,status,IERR)
2837 c write (iout,*) "Gather PRECOMP11"
2839 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2840 & MPI_PRECOMP12(lensend),inext,6600+isend,
2841 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2842 & iprev,6600+irecv,FG_COMM,status,IERR)
2843 c write (iout,*) "Gather PRECOMP12"
2845 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2847 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2848 & MPI_ROTAT2(lensend),inext,7700+isend,
2849 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2850 & iprev,7700+irecv,FG_COMM,status,IERR)
2851 c write (iout,*) "Gather PRECOMP21"
2853 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2854 & MPI_PRECOMP22(lensend),inext,8800+isend,
2855 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2856 & iprev,8800+irecv,FG_COMM,status,IERR)
2857 c write (iout,*) "Gather PRECOMP22"
2859 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2860 & MPI_PRECOMP23(lensend),inext,9900+isend,
2861 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2862 & MPI_PRECOMP23(lenrecv),
2863 & iprev,9900+irecv,FG_COMM,status,IERR)
2864 c write (iout,*) "Gather PRECOMP23"
2869 if (irecv.lt.0) irecv=nfgtasks1-1
2872 time_gather=time_gather+MPI_Wtime()-time00
2875 c if (fg_rank.eq.0) then
2876 write (iout,*) "Arrays UG and UGDER"
2878 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2879 & ((ug(l,k,i),l=1,2),k=1,2),
2880 & ((ugder(l,k,i),l=1,2),k=1,2)
2882 write (iout,*) "Arrays UG2 and UG2DER"
2884 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2885 & ((ug2(l,k,i),l=1,2),k=1,2),
2886 & ((ug2der(l,k,i),l=1,2),k=1,2)
2888 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2890 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2891 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2892 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2894 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2896 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2897 & costab(i),sintab(i),costab2(i),sintab2(i)
2899 write (iout,*) "Array MUDER"
2901 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2907 cd iti = itortyp(itype(i))
2910 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2911 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2916 C--------------------------------------------------------------------------
2917 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2919 C This subroutine calculates the average interaction energy and its gradient
2920 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2921 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2922 C The potential depends both on the distance of peptide-group centers and on
2923 C the orientation of the CA-CA virtual bonds.
2925 implicit real*8 (a-h,o-z)
2929 include 'DIMENSIONS'
2930 include 'COMMON.CONTROL'
2931 include 'COMMON.SETUP'
2932 include 'COMMON.IOUNITS'
2933 include 'COMMON.GEO'
2934 include 'COMMON.VAR'
2935 include 'COMMON.LOCAL'
2936 include 'COMMON.CHAIN'
2937 include 'COMMON.DERIV'
2938 include 'COMMON.INTERACT'
2939 include 'COMMON.CONTACTS'
2940 include 'COMMON.TORSION'
2941 include 'COMMON.VECTORS'
2942 include 'COMMON.FFIELD'
2943 include 'COMMON.TIME1'
2944 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2945 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2946 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2947 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2948 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2949 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2951 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2953 double precision scal_el /1.0d0/
2955 double precision scal_el /0.5d0/
2958 C 13-go grudnia roku pamietnego...
2959 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2960 & 0.0d0,1.0d0,0.0d0,
2961 & 0.0d0,0.0d0,1.0d0/
2962 cd write(iout,*) 'In EELEC'
2964 cd write(iout,*) 'Type',i
2965 cd write(iout,*) 'B1',B1(:,i)
2966 cd write(iout,*) 'B2',B2(:,i)
2967 cd write(iout,*) 'CC',CC(:,:,i)
2968 cd write(iout,*) 'DD',DD(:,:,i)
2969 cd write(iout,*) 'EE',EE(:,:,i)
2971 cd call check_vecgrad
2973 if (icheckgrad.eq.1) then
2975 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2977 dc_norm(k,i)=dc(k,i)*fac
2979 c write (iout,*) 'i',i,' fac',fac
2982 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2983 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2984 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2985 c call vec_and_deriv
2991 time_mat=time_mat+MPI_Wtime()-time01
2995 cd write (iout,*) 'i=',i
2997 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3000 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3001 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3014 cd print '(a)','Enter EELEC'
3015 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3017 gel_loc_loc(i)=0.0d0
3022 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3024 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3026 do i=iturn3_start,iturn3_end
3027 C if (itype(i).eq.21 .or. itype(i+1).eq.21
3028 C & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21.or.itype(i+4).eq.21)
3033 dx_normi=dc_norm(1,i)
3034 dy_normi=dc_norm(2,i)
3035 dz_normi=dc_norm(3,i)
3036 xmedi=c(1,i)+0.5d0*dxi
3037 ymedi=c(2,i)+0.5d0*dyi
3038 zmedi=c(3,i)+0.5d0*dzi
3040 call eelecij(i,i+2,ees,evdw1,eel_loc)
3041 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3042 num_cont_hb(i)=num_conti
3044 do i=iturn4_start,iturn4_end
3045 C if (itype(i).eq.21 .or. itype(i+1).eq.21
3046 C & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21.or.itype(i+4).eq.21
3047 C & .or. itype(i+5).eq.21)
3052 dx_normi=dc_norm(1,i)
3053 dy_normi=dc_norm(2,i)
3054 dz_normi=dc_norm(3,i)
3055 xmedi=c(1,i)+0.5d0*dxi
3056 ymedi=c(2,i)+0.5d0*dyi
3057 zmedi=c(3,i)+0.5d0*dzi
3058 num_conti=num_cont_hb(i)
3059 call eelecij(i,i+3,ees,evdw1,eel_loc)
3060 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3061 num_cont_hb(i)=num_conti
3064 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3066 do i=iatel_s,iatel_e
3067 C if (itype(i).eq.21 .or. itype(i+1).eq.21
3068 C &.or.itype(i+2)) cycle
3072 dx_normi=dc_norm(1,i)
3073 dy_normi=dc_norm(2,i)
3074 dz_normi=dc_norm(3,i)
3075 xmedi=c(1,i)+0.5d0*dxi
3076 ymedi=c(2,i)+0.5d0*dyi
3077 zmedi=c(3,i)+0.5d0*dzi
3078 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3079 num_conti=num_cont_hb(i)
3080 do j=ielstart(i),ielend(i)
3081 C if (itype(j).eq.21 .or. itype(j+1).eq.21
3082 C &.or.itype(j+2)) cycle
3083 call eelecij(i,j,ees,evdw1,eel_loc)
3085 num_cont_hb(i)=num_conti
3087 c write (iout,*) "Number of loop steps in EELEC:",ind
3089 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3090 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3092 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3093 ccc eel_loc=eel_loc+eello_turn3
3094 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3097 C-------------------------------------------------------------------------------
3098 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3099 implicit real*8 (a-h,o-z)
3100 include 'DIMENSIONS'
3104 include 'COMMON.CONTROL'
3105 include 'COMMON.IOUNITS'
3106 include 'COMMON.GEO'
3107 include 'COMMON.VAR'
3108 include 'COMMON.LOCAL'
3109 include 'COMMON.CHAIN'
3110 include 'COMMON.DERIV'
3111 include 'COMMON.INTERACT'
3112 include 'COMMON.CONTACTS'
3113 include 'COMMON.TORSION'
3114 include 'COMMON.VECTORS'
3115 include 'COMMON.FFIELD'
3116 include 'COMMON.TIME1'
3117 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3118 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3119 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3120 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3121 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3122 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3124 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3126 double precision scal_el /1.0d0/
3128 double precision scal_el /0.5d0/
3131 C 13-go grudnia roku pamietnego...
3132 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3133 & 0.0d0,1.0d0,0.0d0,
3134 & 0.0d0,0.0d0,1.0d0/
3135 c time00=MPI_Wtime()
3136 cd write (iout,*) "eelecij",i,j
3140 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3141 aaa=app(iteli,itelj)
3142 bbb=bpp(iteli,itelj)
3143 ael6i=ael6(iteli,itelj)
3144 ael3i=ael3(iteli,itelj)
3148 dx_normj=dc_norm(1,j)
3149 dy_normj=dc_norm(2,j)
3150 dz_normj=dc_norm(3,j)
3151 xj=c(1,j)+0.5D0*dxj-xmedi
3152 yj=c(2,j)+0.5D0*dyj-ymedi
3153 zj=c(3,j)+0.5D0*dzj-zmedi
3154 rij=xj*xj+yj*yj+zj*zj
3160 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3161 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3162 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3163 fac=cosa-3.0D0*cosb*cosg
3165 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3166 if (j.eq.i+2) ev1=scal_el*ev1
3171 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3174 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3175 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3178 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3179 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3180 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3181 cd & xmedi,ymedi,zmedi,xj,yj,zj
3183 if (energy_dec) then
3184 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3185 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3189 C Calculate contributions to the Cartesian gradient.
3192 facvdw=-6*rrmij*(ev1+evdwij)
3193 facel=-3*rrmij*(el1+eesij)
3199 * Radial derivatives. First process both termini of the fragment (i,j)
3205 c ghalf=0.5D0*ggg(k)
3206 c gelc(k,i)=gelc(k,i)+ghalf
3207 c gelc(k,j)=gelc(k,j)+ghalf
3209 c 9/28/08 AL Gradient compotents will be summed only at the end
3211 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3212 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3215 * Loop over residues i+1 thru j-1.
3219 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3226 c ghalf=0.5D0*ggg(k)
3227 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3228 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3230 c 9/28/08 AL Gradient compotents will be summed only at the end
3232 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3233 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3236 * Loop over residues i+1 thru j-1.
3240 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3247 fac=-3*rrmij*(facvdw+facvdw+facel)
3252 * Radial derivatives. First process both termini of the fragment (i,j)
3258 c ghalf=0.5D0*ggg(k)
3259 c gelc(k,i)=gelc(k,i)+ghalf
3260 c gelc(k,j)=gelc(k,j)+ghalf
3262 c 9/28/08 AL Gradient compotents will be summed only at the end
3264 gelc_long(k,j)=gelc(k,j)+ggg(k)
3265 gelc_long(k,i)=gelc(k,i)-ggg(k)
3268 * Loop over residues i+1 thru j-1.
3272 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3275 c 9/28/08 AL Gradient compotents will be summed only at the end
3280 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3281 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3287 ecosa=2.0D0*fac3*fac1+fac4
3290 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3291 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3293 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3294 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3296 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3297 cd & (dcosg(k),k=1,3)
3299 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3302 c ghalf=0.5D0*ggg(k)
3303 c gelc(k,i)=gelc(k,i)+ghalf
3304 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3305 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3306 c gelc(k,j)=gelc(k,j)+ghalf
3307 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3308 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3312 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3317 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3318 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3320 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3321 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3322 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3323 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3325 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3326 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3327 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3329 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3330 C energy of a peptide unit is assumed in the form of a second-order
3331 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3332 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3333 C are computed for EVERY pair of non-contiguous peptide groups.
3335 if (j.lt.nres-1) then
3346 muij(kkk)=mu(k,i)*mu(l,j)
3349 cd write (iout,*) 'EELEC: i',i,' j',j
3350 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3351 cd write(iout,*) 'muij',muij
3352 ury=scalar(uy(1,i),erij)
3353 urz=scalar(uz(1,i),erij)
3354 vry=scalar(uy(1,j),erij)
3355 vrz=scalar(uz(1,j),erij)
3356 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3357 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3358 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3359 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3360 fac=dsqrt(-ael6i)*r3ij
3365 cd write (iout,'(4i5,4f10.5)')
3366 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3367 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3368 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3369 cd & uy(:,j),uz(:,j)
3370 cd write (iout,'(4f10.5)')
3371 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3372 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3373 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3374 cd write (iout,'(9f10.5/)')
3375 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3376 C Derivatives of the elements of A in virtual-bond vectors
3377 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3379 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3380 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3381 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3382 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3383 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3384 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3385 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3386 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3387 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3388 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3389 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3390 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3392 C Compute radial contributions to the gradient
3410 C Add the contributions coming from er
3413 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3414 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3415 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3416 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3419 C Derivatives in DC(i)
3420 cgrad ghalf1=0.5d0*agg(k,1)
3421 cgrad ghalf2=0.5d0*agg(k,2)
3422 cgrad ghalf3=0.5d0*agg(k,3)
3423 cgrad ghalf4=0.5d0*agg(k,4)
3424 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3425 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3426 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3427 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3428 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3429 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3430 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3431 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3432 C Derivatives in DC(i+1)
3433 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3434 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3435 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3436 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3437 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3438 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3439 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3440 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3441 C Derivatives in DC(j)
3442 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3443 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3444 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3445 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3446 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3447 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3448 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3449 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3450 C Derivatives in DC(j+1) or DC(nres-1)
3451 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3452 & -3.0d0*vryg(k,3)*ury)
3453 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3454 & -3.0d0*vrzg(k,3)*ury)
3455 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3456 & -3.0d0*vryg(k,3)*urz)
3457 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3458 & -3.0d0*vrzg(k,3)*urz)
3459 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3461 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
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)
3480 if (j.lt.nres-1) then
3486 aggi(k,l)=-aggi(k,l)
3487 aggi1(k,l)=-aggi1(k,l)
3488 aggj(k,l)=-aggj(k,l)
3489 aggj1(k,l)=-aggj1(k,l)
3500 aggi(k,l)=-aggi(k,l)
3501 aggi1(k,l)=-aggi1(k,l)
3502 aggj(k,l)=-aggj(k,l)
3503 aggj1(k,l)=-aggj1(k,l)
3508 IF (wel_loc.gt.0.0d0) THEN
3509 C Contribution to the local-electrostatic energy coming from the i-j pair
3510 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3512 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3514 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3515 & 'eelloc',i,j,eel_loc_ij
3517 eel_loc=eel_loc+eel_loc_ij
3518 C Partial derivatives in virtual-bond dihedral angles gamma
3520 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3521 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3522 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3523 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3524 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3525 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3526 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3528 ggg(l)=agg(l,1)*muij(1)+
3529 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3530 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3531 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3532 cgrad ghalf=0.5d0*ggg(l)
3533 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3534 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3538 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3541 C Remaining derivatives of eello
3543 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3544 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3545 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3546 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3547 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3548 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3549 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3550 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3553 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3554 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3555 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3556 & .and. num_conti.le.maxconts) then
3557 c write (iout,*) i,j," entered corr"
3559 C Calculate the contact function. The ith column of the array JCONT will
3560 C contain the numbers of atoms that make contacts with the atom I (of numbers
3561 C greater than I). The arrays FACONT and GACONT will contain the values of
3562 C the contact function and its derivative.
3563 c r0ij=1.02D0*rpp(iteli,itelj)
3564 c r0ij=1.11D0*rpp(iteli,itelj)
3565 r0ij=2.20D0*rpp(iteli,itelj)
3566 c r0ij=1.55D0*rpp(iteli,itelj)
3567 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3568 if (fcont.gt.0.0D0) then
3569 num_conti=num_conti+1
3570 if (num_conti.gt.maxconts) then
3571 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3572 & ' will skip next contacts for this conf.'
3574 jcont_hb(num_conti,i)=j
3575 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3576 cd & " jcont_hb",jcont_hb(num_conti,i)
3577 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3578 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3579 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3581 d_cont(num_conti,i)=rij
3582 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3583 C --- Electrostatic-interaction matrix ---
3584 a_chuj(1,1,num_conti,i)=a22
3585 a_chuj(1,2,num_conti,i)=a23
3586 a_chuj(2,1,num_conti,i)=a32
3587 a_chuj(2,2,num_conti,i)=a33
3588 C --- Gradient of rij
3590 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3597 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3598 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3599 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3600 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3601 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3606 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3607 C Calculate contact energies
3609 wij=cosa-3.0D0*cosb*cosg
3612 c fac3=dsqrt(-ael6i)/r0ij**3
3613 fac3=dsqrt(-ael6i)*r3ij
3614 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3615 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3616 if (ees0tmp.gt.0) then
3617 ees0pij=dsqrt(ees0tmp)
3621 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3622 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3623 if (ees0tmp.gt.0) then
3624 ees0mij=dsqrt(ees0tmp)
3629 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3630 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3631 C Diagnostics. Comment out or remove after debugging!
3632 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3633 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3634 c ees0m(num_conti,i)=0.0D0
3636 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3637 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3638 C Angular derivatives of the contact function
3639 ees0pij1=fac3/ees0pij
3640 ees0mij1=fac3/ees0mij
3641 fac3p=-3.0D0*fac3*rrmij
3642 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3643 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3645 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3646 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3647 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3648 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3649 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3650 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3651 ecosap=ecosa1+ecosa2
3652 ecosbp=ecosb1+ecosb2
3653 ecosgp=ecosg1+ecosg2
3654 ecosam=ecosa1-ecosa2
3655 ecosbm=ecosb1-ecosb2
3656 ecosgm=ecosg1-ecosg2
3665 facont_hb(num_conti,i)=fcont
3666 fprimcont=fprimcont/rij
3667 cd facont_hb(num_conti,i)=1.0D0
3668 C Following line is for diagnostics.
3671 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3672 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3675 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3676 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3678 gggp(1)=gggp(1)+ees0pijp*xj
3679 gggp(2)=gggp(2)+ees0pijp*yj
3680 gggp(3)=gggp(3)+ees0pijp*zj
3681 gggm(1)=gggm(1)+ees0mijp*xj
3682 gggm(2)=gggm(2)+ees0mijp*yj
3683 gggm(3)=gggm(3)+ees0mijp*zj
3684 C Derivatives due to the contact function
3685 gacont_hbr(1,num_conti,i)=fprimcont*xj
3686 gacont_hbr(2,num_conti,i)=fprimcont*yj
3687 gacont_hbr(3,num_conti,i)=fprimcont*zj
3690 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3691 c following the change of gradient-summation algorithm.
3693 cgrad ghalfp=0.5D0*gggp(k)
3694 cgrad ghalfm=0.5D0*gggm(k)
3695 gacontp_hb1(k,num_conti,i)=!ghalfp
3696 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3697 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3698 gacontp_hb2(k,num_conti,i)=!ghalfp
3699 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3700 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3701 gacontp_hb3(k,num_conti,i)=gggp(k)
3702 gacontm_hb1(k,num_conti,i)=!ghalfm
3703 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3704 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3705 gacontm_hb2(k,num_conti,i)=!ghalfm
3706 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3707 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3708 gacontm_hb3(k,num_conti,i)=gggm(k)
3710 C Diagnostics. Comment out or remove after debugging!
3712 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3713 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3714 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3715 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3716 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3717 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3720 endif ! num_conti.le.maxconts
3723 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3726 ghalf=0.5d0*agg(l,k)
3727 aggi(l,k)=aggi(l,k)+ghalf
3728 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3729 aggj(l,k)=aggj(l,k)+ghalf
3732 if (j.eq.nres-1 .and. i.lt.j-2) then
3735 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3740 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3743 C-----------------------------------------------------------------------------
3744 subroutine eturn3(i,eello_turn3)
3745 C Third- and fourth-order contributions from turns
3746 implicit real*8 (a-h,o-z)
3747 include 'DIMENSIONS'
3748 include 'COMMON.IOUNITS'
3749 include 'COMMON.GEO'
3750 include 'COMMON.VAR'
3751 include 'COMMON.LOCAL'
3752 include 'COMMON.CHAIN'
3753 include 'COMMON.DERIV'
3754 include 'COMMON.INTERACT'
3755 include 'COMMON.CONTACTS'
3756 include 'COMMON.TORSION'
3757 include 'COMMON.VECTORS'
3758 include 'COMMON.FFIELD'
3759 include 'COMMON.CONTROL'
3761 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3762 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3763 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3764 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3765 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3766 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3767 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3770 c write (iout,*) "eturn3",i,j,j1,j2
3775 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3777 C Third-order contributions
3784 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3785 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3786 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3787 call transpose2(auxmat(1,1),auxmat1(1,1))
3788 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3789 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3790 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3791 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3792 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3793 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3794 cd & ' eello_turn3_num',4*eello_turn3_num
3795 C Derivatives in gamma(i)
3796 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3797 call transpose2(auxmat2(1,1),auxmat3(1,1))
3798 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3799 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3800 C Derivatives in gamma(i+1)
3801 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3802 call transpose2(auxmat2(1,1),auxmat3(1,1))
3803 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3804 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3805 & +0.5d0*(pizda(1,1)+pizda(2,2))
3806 C Cartesian derivatives
3808 c ghalf1=0.5d0*agg(l,1)
3809 c ghalf2=0.5d0*agg(l,2)
3810 c ghalf3=0.5d0*agg(l,3)
3811 c ghalf4=0.5d0*agg(l,4)
3812 a_temp(1,1)=aggi(l,1)!+ghalf1
3813 a_temp(1,2)=aggi(l,2)!+ghalf2
3814 a_temp(2,1)=aggi(l,3)!+ghalf3
3815 a_temp(2,2)=aggi(l,4)!+ghalf4
3816 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3817 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3818 & +0.5d0*(pizda(1,1)+pizda(2,2))
3819 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3820 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3821 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3822 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3823 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3824 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3825 & +0.5d0*(pizda(1,1)+pizda(2,2))
3826 a_temp(1,1)=aggj(l,1)!+ghalf1
3827 a_temp(1,2)=aggj(l,2)!+ghalf2
3828 a_temp(2,1)=aggj(l,3)!+ghalf3
3829 a_temp(2,2)=aggj(l,4)!+ghalf4
3830 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3831 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3832 & +0.5d0*(pizda(1,1)+pizda(2,2))
3833 a_temp(1,1)=aggj1(l,1)
3834 a_temp(1,2)=aggj1(l,2)
3835 a_temp(2,1)=aggj1(l,3)
3836 a_temp(2,2)=aggj1(l,4)
3837 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3838 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3839 & +0.5d0*(pizda(1,1)+pizda(2,2))
3843 C-------------------------------------------------------------------------------
3844 subroutine eturn4(i,eello_turn4)
3845 C Third- and fourth-order contributions from turns
3846 implicit real*8 (a-h,o-z)
3847 include 'DIMENSIONS'
3848 include 'COMMON.IOUNITS'
3849 include 'COMMON.GEO'
3850 include 'COMMON.VAR'
3851 include 'COMMON.LOCAL'
3852 include 'COMMON.CHAIN'
3853 include 'COMMON.DERIV'
3854 include 'COMMON.INTERACT'
3855 include 'COMMON.CONTACTS'
3856 include 'COMMON.TORSION'
3857 include 'COMMON.VECTORS'
3858 include 'COMMON.FFIELD'
3859 include 'COMMON.CONTROL'
3861 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3862 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3863 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3864 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3865 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3866 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3867 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3870 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3872 C Fourth-order contributions
3880 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3881 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3882 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3887 iti1=itortyp(itype(i+1))
3888 iti2=itortyp(itype(i+2))
3889 iti3=itortyp(itype(i+3))
3890 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3891 call transpose2(EUg(1,1,i+1),e1t(1,1))
3892 call transpose2(Eug(1,1,i+2),e2t(1,1))
3893 call transpose2(Eug(1,1,i+3),e3t(1,1))
3894 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3895 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3896 s1=scalar2(b1(1,iti2),auxvec(1))
3897 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3898 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3899 s2=scalar2(b1(1,iti1),auxvec(1))
3900 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3901 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3902 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3903 eello_turn4=eello_turn4-(s1+s2+s3)
3904 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3905 & 'eturn4',i,j,-(s1+s2+s3)
3906 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3907 cd & ' eello_turn4_num',8*eello_turn4_num
3908 C Derivatives in gamma(i)
3909 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3910 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3911 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3912 s1=scalar2(b1(1,iti2),auxvec(1))
3913 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3914 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3915 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3916 C Derivatives in gamma(i+1)
3917 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3918 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3919 s2=scalar2(b1(1,iti1),auxvec(1))
3920 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3921 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3922 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3923 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3924 C Derivatives in gamma(i+2)
3925 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3926 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3927 s1=scalar2(b1(1,iti2),auxvec(1))
3928 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3929 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3930 s2=scalar2(b1(1,iti1),auxvec(1))
3931 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3932 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3933 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3934 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3935 C Cartesian derivatives
3936 C Derivatives of this turn contributions in DC(i+2)
3937 if (j.lt.nres-1) then
3939 a_temp(1,1)=agg(l,1)
3940 a_temp(1,2)=agg(l,2)
3941 a_temp(2,1)=agg(l,3)
3942 a_temp(2,2)=agg(l,4)
3943 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3944 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3945 s1=scalar2(b1(1,iti2),auxvec(1))
3946 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3947 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3948 s2=scalar2(b1(1,iti1),auxvec(1))
3949 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3950 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3951 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3953 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3956 C Remaining derivatives of this turn contribution
3958 a_temp(1,1)=aggi(l,1)
3959 a_temp(1,2)=aggi(l,2)
3960 a_temp(2,1)=aggi(l,3)
3961 a_temp(2,2)=aggi(l,4)
3962 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3963 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3964 s1=scalar2(b1(1,iti2),auxvec(1))
3965 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3966 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3967 s2=scalar2(b1(1,iti1),auxvec(1))
3968 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3969 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3970 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3971 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3972 a_temp(1,1)=aggi1(l,1)
3973 a_temp(1,2)=aggi1(l,2)
3974 a_temp(2,1)=aggi1(l,3)
3975 a_temp(2,2)=aggi1(l,4)
3976 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3977 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3978 s1=scalar2(b1(1,iti2),auxvec(1))
3979 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3980 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3981 s2=scalar2(b1(1,iti1),auxvec(1))
3982 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3983 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3984 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3985 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3986 a_temp(1,1)=aggj(l,1)
3987 a_temp(1,2)=aggj(l,2)
3988 a_temp(2,1)=aggj(l,3)
3989 a_temp(2,2)=aggj(l,4)
3990 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3991 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3992 s1=scalar2(b1(1,iti2),auxvec(1))
3993 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3994 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3995 s2=scalar2(b1(1,iti1),auxvec(1))
3996 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3997 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3998 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3999 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4000 a_temp(1,1)=aggj1(l,1)
4001 a_temp(1,2)=aggj1(l,2)
4002 a_temp(2,1)=aggj1(l,3)
4003 a_temp(2,2)=aggj1(l,4)
4004 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4005 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4006 s1=scalar2(b1(1,iti2),auxvec(1))
4007 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4008 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4009 s2=scalar2(b1(1,iti1),auxvec(1))
4010 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4011 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4012 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4013 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4014 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4018 C-----------------------------------------------------------------------------
4019 subroutine vecpr(u,v,w)
4020 implicit real*8(a-h,o-z)
4021 dimension u(3),v(3),w(3)
4022 w(1)=u(2)*v(3)-u(3)*v(2)
4023 w(2)=-u(1)*v(3)+u(3)*v(1)
4024 w(3)=u(1)*v(2)-u(2)*v(1)
4027 C-----------------------------------------------------------------------------
4028 subroutine unormderiv(u,ugrad,unorm,ungrad)
4029 C This subroutine computes the derivatives of a normalized vector u, given
4030 C the derivatives computed without normalization conditions, ugrad. Returns
4033 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4034 double precision vec(3)
4035 double precision scalar
4037 c write (2,*) 'ugrad',ugrad
4040 vec(i)=scalar(ugrad(1,i),u(1))
4042 c write (2,*) 'vec',vec
4045 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4048 c write (2,*) 'ungrad',ungrad
4051 C-----------------------------------------------------------------------------
4052 subroutine escp_soft_sphere(evdw2,evdw2_14)
4054 C This subroutine calculates the excluded-volume interaction energy between
4055 C peptide-group centers and side chains and its gradient in virtual-bond and
4056 C side-chain vectors.
4058 implicit real*8 (a-h,o-z)
4059 include 'DIMENSIONS'
4060 include 'COMMON.GEO'
4061 include 'COMMON.VAR'
4062 include 'COMMON.LOCAL'
4063 include 'COMMON.CHAIN'
4064 include 'COMMON.DERIV'
4065 include 'COMMON.INTERACT'
4066 include 'COMMON.FFIELD'
4067 include 'COMMON.IOUNITS'
4068 include 'COMMON.CONTROL'
4073 cd print '(a)','Enter ESCP'
4074 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4075 do i=iatscp_s,iatscp_e
4077 xi=0.5D0*(c(1,i)+c(1,i+1))
4078 yi=0.5D0*(c(2,i)+c(2,i+1))
4079 zi=0.5D0*(c(3,i)+c(3,i+1))
4081 do iint=1,nscp_gr(i)
4083 do j=iscpstart(i,iint),iscpend(i,iint)
4085 C Uncomment following three lines for SC-p interactions
4089 C Uncomment following three lines for Ca-p interactions
4093 rij=xj*xj+yj*yj+zj*zj
4096 if (rij.lt.r0ijsq) then
4097 evdwij=0.25d0*(rij-r0ijsq)**2
4105 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4110 cgrad if (j.lt.i) then
4111 cd write (iout,*) 'j<i'
4112 C Uncomment following three lines for SC-p interactions
4114 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4117 cd write (iout,*) 'j>i'
4119 cgrad ggg(k)=-ggg(k)
4120 C Uncomment following line for SC-p interactions
4121 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4125 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4127 cgrad kstart=min0(i+1,j)
4128 cgrad kend=max0(i-1,j-1)
4129 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4130 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4131 cgrad do k=kstart,kend
4133 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4137 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4138 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4146 C-----------------------------------------------------------------------------
4147 subroutine escp(evdw2,evdw2_14)
4149 C This subroutine calculates the excluded-volume interaction energy between
4150 C peptide-group centers and side chains and its gradient in virtual-bond and
4151 C side-chain vectors.
4153 implicit real*8 (a-h,o-z)
4154 include 'DIMENSIONS'
4155 include 'COMMON.GEO'
4156 include 'COMMON.VAR'
4157 include 'COMMON.LOCAL'
4158 include 'COMMON.CHAIN'
4159 include 'COMMON.DERIV'
4160 include 'COMMON.INTERACT'
4161 include 'COMMON.FFIELD'
4162 include 'COMMON.IOUNITS'
4163 include 'COMMON.CONTROL'
4167 cd print '(a)','Enter ESCP'
4168 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4169 do i=iatscp_s,iatscp_e
4171 xi=0.5D0*(c(1,i)+c(1,i+1))
4172 yi=0.5D0*(c(2,i)+c(2,i+1))
4173 zi=0.5D0*(c(3,i)+c(3,i+1))
4175 do iint=1,nscp_gr(i)
4177 do j=iscpstart(i,iint),iscpend(i,iint)
4179 C Uncomment following three lines for SC-p interactions
4183 C Uncomment following three lines for Ca-p interactions
4187 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4189 e1=fac*fac*aad(itypj,iteli)
4190 e2=fac*bad(itypj,iteli)
4191 if (iabs(j-i) .le. 2) then
4194 evdw2_14=evdw2_14+e1+e2
4198 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4199 & 'evdw2',i,j,evdwij
4201 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4203 fac=-(evdwij+e1)*rrij
4207 cgrad if (j.lt.i) then
4208 cd write (iout,*) 'j<i'
4209 C Uncomment following three lines for SC-p interactions
4211 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4214 cd write (iout,*) 'j>i'
4216 cgrad ggg(k)=-ggg(k)
4217 C Uncomment following line for SC-p interactions
4218 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4219 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4223 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4225 cgrad kstart=min0(i+1,j)
4226 cgrad kend=max0(i-1,j-1)
4227 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4228 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4229 cgrad do k=kstart,kend
4231 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4235 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4236 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4244 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4245 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4246 gradx_scp(j,i)=expon*gradx_scp(j,i)
4249 C******************************************************************************
4253 C To save time the factor EXPON has been extracted from ALL components
4254 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4257 C******************************************************************************
4260 C--------------------------------------------------------------------------
4261 subroutine edis(ehpb)
4263 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4265 implicit real*8 (a-h,o-z)
4266 include 'DIMENSIONS'
4267 include 'COMMON.SBRIDGE'
4268 include 'COMMON.CHAIN'
4269 include 'COMMON.DERIV'
4270 include 'COMMON.VAR'
4271 include 'COMMON.INTERACT'
4272 include 'COMMON.IOUNITS'
4275 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4276 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4277 if (link_end.eq.0) return
4278 do i=link_start,link_end
4279 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4280 C CA-CA distance used in regularization of structure.
4283 C iii and jjj point to the residues for which the distance is assigned.
4284 if (ii.gt.nres) then
4291 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4292 c & dhpb(i),dhpb1(i),forcon(i)
4293 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4294 C distance and angle dependent SS bond potential.
4295 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4296 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4297 if (.not.dyn_ss .and. i.le.nss) then
4298 C 15/02/13 CC dynamic SSbond - additional check
4300 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4301 call ssbond_ene(iii,jjj,eij)
4304 cd write (iout,*) "eij",eij
4305 else if (ii.gt.nres .and. jj.gt.nres) then
4306 c Restraints from contact prediction
4308 if (dhpb1(i).gt.0.0d0) then
4309 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4310 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4311 c write (iout,*) "beta nmr",
4312 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4316 C Get the force constant corresponding to this distance.
4318 C Calculate the contribution to energy.
4319 ehpb=ehpb+waga*rdis*rdis
4320 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4322 C Evaluate gradient.
4327 ggg(j)=fac*(c(j,jj)-c(j,ii))
4330 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4331 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4334 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4335 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4338 C Calculate the distance between the two points and its difference from the
4341 if (dhpb1(i).gt.0.0d0) then
4342 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4343 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4344 c write (iout,*) "alph nmr",
4345 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4348 C Get the force constant corresponding to this distance.
4350 C Calculate the contribution to energy.
4351 ehpb=ehpb+waga*rdis*rdis
4352 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4354 C Evaluate gradient.
4358 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4359 cd & ' waga=',waga,' fac=',fac
4361 ggg(j)=fac*(c(j,jj)-c(j,ii))
4363 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4364 C If this is a SC-SC distance, we need to calculate the contributions to the
4365 C Cartesian gradient in the SC vectors (ghpbx).
4368 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4369 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4372 cgrad do j=iii,jjj-1
4374 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4378 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4379 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4386 C--------------------------------------------------------------------------
4387 subroutine ssbond_ene(i,j,eij)
4389 C Calculate the distance and angle dependent SS-bond potential energy
4390 C using a free-energy function derived based on RHF/6-31G** ab initio
4391 C calculations of diethyl disulfide.
4393 C A. Liwo and U. Kozlowska, 11/24/03
4395 implicit real*8 (a-h,o-z)
4396 include 'DIMENSIONS'
4397 include 'COMMON.SBRIDGE'
4398 include 'COMMON.CHAIN'
4399 include 'COMMON.DERIV'
4400 include 'COMMON.LOCAL'
4401 include 'COMMON.INTERACT'
4402 include 'COMMON.VAR'
4403 include 'COMMON.IOUNITS'
4404 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4409 dxi=dc_norm(1,nres+i)
4410 dyi=dc_norm(2,nres+i)
4411 dzi=dc_norm(3,nres+i)
4412 c dsci_inv=dsc_inv(itypi)
4413 dsci_inv=vbld_inv(nres+i)
4415 c dscj_inv=dsc_inv(itypj)
4416 dscj_inv=vbld_inv(nres+j)
4420 dxj=dc_norm(1,nres+j)
4421 dyj=dc_norm(2,nres+j)
4422 dzj=dc_norm(3,nres+j)
4423 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4428 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4429 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4430 om12=dxi*dxj+dyi*dyj+dzi*dzj
4432 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4433 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4439 deltat12=om2-om1+2.0d0
4441 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4442 & +akct*deltad*deltat12+ebr
4443 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4444 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4445 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4446 c & " deltat12",deltat12," eij",eij
4447 ed=2*akcm*deltad+akct*deltat12
4449 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4450 eom1=-2*akth*deltat1-pom1-om2*pom2
4451 eom2= 2*akth*deltat2+pom1-om1*pom2
4454 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4455 ghpbx(k,i)=ghpbx(k,i)-ggk
4456 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4457 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4458 ghpbx(k,j)=ghpbx(k,j)+ggk
4459 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4460 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4461 ghpbc(k,i)=ghpbc(k,i)-ggk
4462 ghpbc(k,j)=ghpbc(k,j)+ggk
4465 C Calculate the components of the gradient in DC and X
4469 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4474 C--------------------------------------------------------------------------
4475 subroutine ebond(estr)
4477 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4479 implicit real*8 (a-h,o-z)
4480 include 'DIMENSIONS'
4481 include 'COMMON.LOCAL'
4482 include 'COMMON.GEO'
4483 include 'COMMON.INTERACT'
4484 include 'COMMON.DERIV'
4485 include 'COMMON.VAR'
4486 include 'COMMON.CHAIN'
4487 include 'COMMON.IOUNITS'
4488 include 'COMMON.NAMES'
4489 include 'COMMON.FFIELD'
4490 include 'COMMON.CONTROL'
4491 include 'COMMON.SETUP'
4492 double precision u(3),ud(3)
4494 do i=ibondp_start,ibondp_end
4495 diff = vbld(i)-vbldp0
4496 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4497 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4498 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4501 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4503 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4507 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4509 do i=ibond_start,ibond_end
4514 diff=vbld(i+nres)-vbldsc0(1,iti)
4515 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4516 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4517 if (energy_dec) then
4519 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4520 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4523 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4525 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4529 diff=vbld(i+nres)-vbldsc0(j,iti)
4530 ud(j)=aksc(j,iti)*diff
4531 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4545 uprod2=uprod2*u(k)*u(k)
4549 usumsqder=usumsqder+ud(j)*uprod2
4551 estr=estr+uprod/usum
4553 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4561 C--------------------------------------------------------------------------
4562 subroutine ebend(etheta)
4564 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4565 C angles gamma and its derivatives in consecutive thetas and gammas.
4567 implicit real*8 (a-h,o-z)
4568 include 'DIMENSIONS'
4569 include 'COMMON.LOCAL'
4570 include 'COMMON.GEO'
4571 include 'COMMON.INTERACT'
4572 include 'COMMON.DERIV'
4573 include 'COMMON.VAR'
4574 include 'COMMON.CHAIN'
4575 include 'COMMON.IOUNITS'
4576 include 'COMMON.NAMES'
4577 include 'COMMON.FFIELD'
4578 include 'COMMON.CONTROL'
4579 common /calcthet/ term1,term2,termm,diffak,ratak,
4580 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4581 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4582 double precision y(2),z(2)
4584 c time11=dexp(-2*time)
4587 c write (*,'(a,i2)') 'EBEND ICG=',icg
4588 do i=ithet_start,ithet_end
4589 C Zero the energy function and its derivative at 0 or pi.
4590 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4595 if (phii.ne.phii) phii=150.0
4608 if (phii1.ne.phii1) phii1=150.0
4620 C Calculate the "mean" value of theta from the part of the distribution
4621 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4622 C In following comments this theta will be referred to as t_c.
4623 thet_pred_mean=0.0d0
4627 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4629 dthett=thet_pred_mean*ssd
4630 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4631 C Derivatives of the "mean" values in gamma1 and gamma2.
4632 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4633 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4634 if (theta(i).gt.pi-delta) then
4635 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4637 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4638 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4639 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4641 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4643 else if (theta(i).lt.delta) then
4644 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4645 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4646 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4648 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4649 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4652 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4655 etheta=etheta+ethetai
4656 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4658 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4659 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4660 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4662 C Ufff.... We've done all this!!!
4665 C---------------------------------------------------------------------------
4666 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4668 implicit real*8 (a-h,o-z)
4669 include 'DIMENSIONS'
4670 include 'COMMON.LOCAL'
4671 include 'COMMON.IOUNITS'
4672 common /calcthet/ term1,term2,termm,diffak,ratak,
4673 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4674 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4675 C Calculate the contributions to both Gaussian lobes.
4676 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4677 C The "polynomial part" of the "standard deviation" of this part of
4681 sig=sig*thet_pred_mean+polthet(j,it)
4683 C Derivative of the "interior part" of the "standard deviation of the"
4684 C gamma-dependent Gaussian lobe in t_c.
4685 sigtc=3*polthet(3,it)
4687 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4690 C Set the parameters of both Gaussian lobes of the distribution.
4691 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4692 fac=sig*sig+sigc0(it)
4695 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4696 sigsqtc=-4.0D0*sigcsq*sigtc
4697 c print *,i,sig,sigtc,sigsqtc
4698 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4699 sigtc=-sigtc/(fac*fac)
4700 C Following variable is sigma(t_c)**(-2)
4701 sigcsq=sigcsq*sigcsq
4703 sig0inv=1.0D0/sig0i**2
4704 delthec=thetai-thet_pred_mean
4705 delthe0=thetai-theta0i
4706 term1=-0.5D0*sigcsq*delthec*delthec
4707 term2=-0.5D0*sig0inv*delthe0*delthe0
4708 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4709 C NaNs in taking the logarithm. We extract the largest exponent which is added
4710 C to the energy (this being the log of the distribution) at the end of energy
4711 C term evaluation for this virtual-bond angle.
4712 if (term1.gt.term2) then
4714 term2=dexp(term2-termm)
4718 term1=dexp(term1-termm)
4721 C The ratio between the gamma-independent and gamma-dependent lobes of
4722 C the distribution is a Gaussian function of thet_pred_mean too.
4723 diffak=gthet(2,it)-thet_pred_mean
4724 ratak=diffak/gthet(3,it)**2
4725 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4726 C Let's differentiate it in thet_pred_mean NOW.
4728 C Now put together the distribution terms to make complete distribution.
4729 termexp=term1+ak*term2
4730 termpre=sigc+ak*sig0i
4731 C Contribution of the bending energy from this theta is just the -log of
4732 C the sum of the contributions from the two lobes and the pre-exponential
4733 C factor. Simple enough, isn't it?
4734 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4735 C NOW the derivatives!!!
4736 C 6/6/97 Take into account the deformation.
4737 E_theta=(delthec*sigcsq*term1
4738 & +ak*delthe0*sig0inv*term2)/termexp
4739 E_tc=((sigtc+aktc*sig0i)/termpre
4740 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4741 & aktc*term2)/termexp)
4744 c-----------------------------------------------------------------------------
4745 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4746 implicit real*8 (a-h,o-z)
4747 include 'DIMENSIONS'
4748 include 'COMMON.LOCAL'
4749 include 'COMMON.IOUNITS'
4750 common /calcthet/ term1,term2,termm,diffak,ratak,
4751 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4752 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4753 delthec=thetai-thet_pred_mean
4754 delthe0=thetai-theta0i
4755 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4756 t3 = thetai-thet_pred_mean
4760 t14 = t12+t6*sigsqtc
4762 t21 = thetai-theta0i
4768 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4769 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4770 & *(-t12*t9-ak*sig0inv*t27)
4774 C--------------------------------------------------------------------------
4775 subroutine ebend(etheta)
4777 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4778 C angles gamma and its derivatives in consecutive thetas and gammas.
4779 C ab initio-derived potentials from
4780 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4782 implicit real*8 (a-h,o-z)
4783 include 'DIMENSIONS'
4784 include 'COMMON.LOCAL'
4785 include 'COMMON.GEO'
4786 include 'COMMON.INTERACT'
4787 include 'COMMON.DERIV'
4788 include 'COMMON.VAR'
4789 include 'COMMON.CHAIN'
4790 include 'COMMON.IOUNITS'
4791 include 'COMMON.NAMES'
4792 include 'COMMON.FFIELD'
4793 include 'COMMON.CONTROL'
4794 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4795 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4796 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4797 & sinph1ph2(maxdouble,maxdouble)
4798 logical lprn /.false./, lprn1 /.false./
4800 do i=ithet_start,ithet_end
4801 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4802 &(itype(i).eq.ntyp1)) cycle
4806 theti2=0.5d0*theta(i)
4807 ityp2=ithetyp(itype(i-1))
4809 coskt(k)=dcos(k*theti2)
4810 sinkt(k)=dsin(k*theti2)
4813 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4816 if (phii.ne.phii) phii=150.0
4820 ityp1=ithetyp(itype(i-2))
4822 cosph1(k)=dcos(k*phii)
4823 sinph1(k)=dsin(k*phii)
4827 ityp1=ithetyp(itype(i-2))
4833 if ((i.lt.nres).and. itype(i+1).ne.ntyp1) then
4836 if (phii1.ne.phii1) phii1=150.0
4841 ityp3=ithetyp(itype(i))
4843 cosph2(k)=dcos(k*phii1)
4844 sinph2(k)=dsin(k*phii1)
4848 ityp3=ithetyp(itype(i))
4854 ethetai=aa0thet(ityp1,ityp2,ityp3)
4857 ccl=cosph1(l)*cosph2(k-l)
4858 ssl=sinph1(l)*sinph2(k-l)
4859 scl=sinph1(l)*cosph2(k-l)
4860 csl=cosph1(l)*sinph2(k-l)
4861 cosph1ph2(l,k)=ccl-ssl
4862 cosph1ph2(k,l)=ccl+ssl
4863 sinph1ph2(l,k)=scl+csl
4864 sinph1ph2(k,l)=scl-csl
4868 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4869 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4870 write (iout,*) "coskt and sinkt"
4872 write (iout,*) k,coskt(k),sinkt(k)
4876 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4877 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4880 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4881 & " ethetai",ethetai
4884 write (iout,*) "cosph and sinph"
4886 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4888 write (iout,*) "cosph1ph2 and sinph2ph2"
4891 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4892 & sinph1ph2(l,k),sinph1ph2(k,l)
4895 write(iout,*) "ethetai",ethetai
4899 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4900 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4901 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4902 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4903 ethetai=ethetai+sinkt(m)*aux
4904 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4905 dephii=dephii+k*sinkt(m)*(
4906 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4907 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4908 dephii1=dephii1+k*sinkt(m)*(
4909 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4910 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4912 & write (iout,*) "m",m," k",k," bbthet",
4913 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4914 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4915 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4916 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4920 & write(iout,*) "ethetai",ethetai
4924 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4925 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4926 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4927 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4928 ethetai=ethetai+sinkt(m)*aux
4929 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4930 dephii=dephii+l*sinkt(m)*(
4931 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4932 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4933 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4934 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4935 dephii1=dephii1+(k-l)*sinkt(m)*(
4936 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4937 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4938 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4939 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4941 write (iout,*) "m",m," k",k," l",l," ffthet",
4942 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4943 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4944 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4945 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4946 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4947 & cosph1ph2(k,l)*sinkt(m),
4948 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4954 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4955 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
4956 & phii1*rad2deg,ethetai
4957 etheta=etheta+ethetai
4958 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4960 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4961 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4962 gloc(nphi+i-2,icg)=wang*dethetai
4968 c-----------------------------------------------------------------------------
4969 subroutine esc(escloc)
4970 C Calculate the local energy of a side chain and its derivatives in the
4971 C corresponding virtual-bond valence angles THETA and the spherical angles
4973 implicit real*8 (a-h,o-z)
4974 include 'DIMENSIONS'
4975 include 'COMMON.GEO'
4976 include 'COMMON.LOCAL'
4977 include 'COMMON.VAR'
4978 include 'COMMON.INTERACT'
4979 include 'COMMON.DERIV'
4980 include 'COMMON.CHAIN'
4981 include 'COMMON.IOUNITS'
4982 include 'COMMON.NAMES'
4983 include 'COMMON.FFIELD'
4984 include 'COMMON.CONTROL'
4985 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4986 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4987 common /sccalc/ time11,time12,time112,theti,it,nlobit
4990 c write (iout,'(a)') 'ESC'
4991 do i=loc_start,loc_end
4993 if (it.eq.10) goto 1
4995 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4996 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4997 theti=theta(i+1)-pipol
5002 if (x(2).gt.pi-delta) then
5006 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5008 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5009 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5011 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5012 & ddersc0(1),dersc(1))
5013 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5014 & ddersc0(3),dersc(3))
5016 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5018 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5019 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5020 & dersc0(2),esclocbi,dersc02)
5021 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5023 call splinthet(x(2),0.5d0*delta,ss,ssd)
5028 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5030 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5031 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5033 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5035 c write (iout,*) escloci
5036 else if (x(2).lt.delta) then
5040 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5042 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5043 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5045 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5046 & ddersc0(1),dersc(1))
5047 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5048 & ddersc0(3),dersc(3))
5050 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5052 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5053 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5054 & dersc0(2),esclocbi,dersc02)
5055 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5060 call splinthet(x(2),0.5d0*delta,ss,ssd)
5062 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5064 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5065 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5067 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5068 c write (iout,*) escloci
5070 call enesc(x,escloci,dersc,ddummy,.false.)
5073 escloc=escloc+escloci
5074 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5075 & 'escloc',i,escloci
5076 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5078 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5080 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5081 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5086 C---------------------------------------------------------------------------
5087 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5088 implicit real*8 (a-h,o-z)
5089 include 'DIMENSIONS'
5090 include 'COMMON.GEO'
5091 include 'COMMON.LOCAL'
5092 include 'COMMON.IOUNITS'
5093 common /sccalc/ time11,time12,time112,theti,it,nlobit
5094 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5095 double precision contr(maxlob,-1:1)
5097 c write (iout,*) 'it=',it,' nlobit=',nlobit
5101 if (mixed) ddersc(j)=0.0d0
5105 C Because of periodicity of the dependence of the SC energy in omega we have
5106 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5107 C To avoid underflows, first compute & store the exponents.
5115 z(k)=x(k)-censc(k,j,it)
5120 Axk=Axk+gaussc(l,k,j,it)*z(l)
5126 expfac=expfac+Ax(k,j,iii)*z(k)
5134 C As in the case of ebend, we want to avoid underflows in exponentiation and
5135 C subsequent NaNs and INFs in energy calculation.
5136 C Find the largest exponent
5140 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5144 cd print *,'it=',it,' emin=',emin
5146 C Compute the contribution to SC energy and derivatives
5151 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5152 if(adexp.ne.adexp) adexp=1.0
5155 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5157 cd print *,'j=',j,' expfac=',expfac
5158 escloc_i=escloc_i+expfac
5160 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5164 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5165 & +gaussc(k,2,j,it))*expfac
5172 dersc(1)=dersc(1)/cos(theti)**2
5173 ddersc(1)=ddersc(1)/cos(theti)**2
5176 escloci=-(dlog(escloc_i)-emin)
5178 dersc(j)=dersc(j)/escloc_i
5182 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5187 C------------------------------------------------------------------------------
5188 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5189 implicit real*8 (a-h,o-z)
5190 include 'DIMENSIONS'
5191 include 'COMMON.GEO'
5192 include 'COMMON.LOCAL'
5193 include 'COMMON.IOUNITS'
5194 common /sccalc/ time11,time12,time112,theti,it,nlobit
5195 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5196 double precision contr(maxlob)
5207 z(k)=x(k)-censc(k,j,it)
5213 Axk=Axk+gaussc(l,k,j,it)*z(l)
5219 expfac=expfac+Ax(k,j)*z(k)
5224 C As in the case of ebend, we want to avoid underflows in exponentiation and
5225 C subsequent NaNs and INFs in energy calculation.
5226 C Find the largest exponent
5229 if (emin.gt.contr(j)) emin=contr(j)
5233 C Compute the contribution to SC energy and derivatives
5237 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5238 escloc_i=escloc_i+expfac
5240 dersc(k)=dersc(k)+Ax(k,j)*expfac
5242 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5243 & +gaussc(1,2,j,it))*expfac
5247 dersc(1)=dersc(1)/cos(theti)**2
5248 dersc12=dersc12/cos(theti)**2
5249 escloci=-(dlog(escloc_i)-emin)
5251 dersc(j)=dersc(j)/escloc_i
5253 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5257 c----------------------------------------------------------------------------------
5258 subroutine esc(escloc)
5259 C Calculate the local energy of a side chain and its derivatives in the
5260 C corresponding virtual-bond valence angles THETA and the spherical angles
5261 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5262 C added by Urszula Kozlowska. 07/11/2007
5264 implicit real*8 (a-h,o-z)
5265 include 'DIMENSIONS'
5266 include 'COMMON.GEO'
5267 include 'COMMON.LOCAL'
5268 include 'COMMON.VAR'
5269 include 'COMMON.SCROT'
5270 include 'COMMON.INTERACT'
5271 include 'COMMON.DERIV'
5272 include 'COMMON.CHAIN'
5273 include 'COMMON.IOUNITS'
5274 include 'COMMON.NAMES'
5275 include 'COMMON.FFIELD'
5276 include 'COMMON.CONTROL'
5277 include 'COMMON.VECTORS'
5278 double precision x_prime(3),y_prime(3),z_prime(3)
5279 & , sumene,dsc_i,dp2_i,x(65),
5280 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5281 & de_dxx,de_dyy,de_dzz,de_dt
5282 double precision s1_t,s1_6_t,s2_t,s2_6_t
5284 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5285 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5286 & dt_dCi(3),dt_dCi1(3)
5287 common /sccalc/ time11,time12,time112,theti,it,nlobit
5290 do i=loc_start,loc_end
5291 costtab(i+1) =dcos(theta(i+1))
5292 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5293 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5294 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5295 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5296 cosfac=dsqrt(cosfac2)
5297 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5298 sinfac=dsqrt(sinfac2)
5300 if (it.eq.10) goto 1
5302 C Compute the axes of tghe local cartesian coordinates system; store in
5303 c x_prime, y_prime and z_prime
5310 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5311 C & dc_norm(3,i+nres)
5313 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5314 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5317 z_prime(j) = -uz(j,i-1)
5320 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5321 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5322 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5323 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5324 c & " xy",scalar(x_prime(1),y_prime(1)),
5325 c & " xz",scalar(x_prime(1),z_prime(1)),
5326 c & " yy",scalar(y_prime(1),y_prime(1)),
5327 c & " yz",scalar(y_prime(1),z_prime(1)),
5328 c & " zz",scalar(z_prime(1),z_prime(1))
5330 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5331 C to local coordinate system. Store in xx, yy, zz.
5337 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5338 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5339 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5346 C Compute the energy of the ith side cbain
5348 c write (2,*) "xx",xx," yy",yy," zz",zz
5351 x(j) = sc_parmin(j,it)
5354 Cc diagnostics - remove later
5356 yy1 = dsin(alph(2))*dcos(omeg(2))
5357 zz1 = -dsin(alph(2))*dsin(omeg(2))
5358 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5359 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5361 C," --- ", xx_w,yy_w,zz_w
5364 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5365 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5367 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5368 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5370 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5371 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5372 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5373 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5374 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5376 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5377 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5378 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5379 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5380 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5382 dsc_i = 0.743d0+x(61)
5384 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5385 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5386 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5387 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5388 s1=(1+x(63))/(0.1d0 + dscp1)
5389 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5390 s2=(1+x(65))/(0.1d0 + dscp2)
5391 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5392 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5393 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5394 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5396 c & dscp1,dscp2,sumene
5397 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5398 escloc = escloc + sumene
5399 c write (2,*) "i",i," escloc",sumene,escloc
5402 C This section to check the numerical derivatives of the energy of ith side
5403 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5404 C #define DEBUG in the code to turn it on.
5406 write (2,*) "sumene =",sumene
5410 write (2,*) xx,yy,zz
5411 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5412 de_dxx_num=(sumenep-sumene)/aincr
5414 write (2,*) "xx+ sumene from enesc=",sumenep
5417 write (2,*) xx,yy,zz
5418 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5419 de_dyy_num=(sumenep-sumene)/aincr
5421 write (2,*) "yy+ sumene from enesc=",sumenep
5424 write (2,*) xx,yy,zz
5425 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5426 de_dzz_num=(sumenep-sumene)/aincr
5428 write (2,*) "zz+ sumene from enesc=",sumenep
5429 costsave=cost2tab(i+1)
5430 sintsave=sint2tab(i+1)
5431 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5432 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5433 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5434 de_dt_num=(sumenep-sumene)/aincr
5435 write (2,*) " t+ sumene from enesc=",sumenep
5436 cost2tab(i+1)=costsave
5437 sint2tab(i+1)=sintsave
5438 C End of diagnostics section.
5441 C Compute the gradient of esc
5443 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5444 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5445 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5446 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5447 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5448 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5449 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5450 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5451 pom1=(sumene3*sint2tab(i+1)+sumene1)
5452 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5453 pom2=(sumene4*cost2tab(i+1)+sumene2)
5454 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5455 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5456 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5457 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5459 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5460 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5461 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5463 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5464 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5465 & +(pom1+pom2)*pom_dx
5467 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5470 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5471 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5472 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5474 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5475 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5476 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5477 & +x(59)*zz**2 +x(60)*xx*zz
5478 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5479 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5480 & +(pom1-pom2)*pom_dy
5482 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5485 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5486 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5487 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5488 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5489 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5490 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5491 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5492 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5494 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5497 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5498 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5499 & +pom1*pom_dt1+pom2*pom_dt2
5501 write(2,*), "de_dt = ", de_dt,de_dt_num
5505 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5506 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5507 cosfac2xx=cosfac2*xx
5508 sinfac2yy=sinfac2*yy
5510 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5512 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5514 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5515 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5516 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5517 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5518 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5519 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5520 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5521 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5522 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5523 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5527 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5528 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5531 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5532 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5533 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5535 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5536 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5540 dXX_Ctab(k,i)=dXX_Ci(k)
5541 dXX_C1tab(k,i)=dXX_Ci1(k)
5542 dYY_Ctab(k,i)=dYY_Ci(k)
5543 dYY_C1tab(k,i)=dYY_Ci1(k)
5544 dZZ_Ctab(k,i)=dZZ_Ci(k)
5545 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5546 dXX_XYZtab(k,i)=dXX_XYZ(k)
5547 dYY_XYZtab(k,i)=dYY_XYZ(k)
5548 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5552 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5553 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5554 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5555 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5556 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5558 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5559 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5560 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5561 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5562 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5563 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5564 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5565 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5567 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5568 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5570 C to check gradient call subroutine check_grad
5576 c------------------------------------------------------------------------------
5577 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5579 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5580 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5581 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5582 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5584 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5585 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5587 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5588 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5589 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5590 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5591 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5593 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5594 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5595 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5596 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5597 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5599 dsc_i = 0.743d0+x(61)
5601 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5602 & *(xx*cost2+yy*sint2))
5603 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5604 & *(xx*cost2-yy*sint2))
5605 s1=(1+x(63))/(0.1d0 + dscp1)
5606 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5607 s2=(1+x(65))/(0.1d0 + dscp2)
5608 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5609 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5610 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5615 c------------------------------------------------------------------------------
5616 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5618 C This procedure calculates two-body contact function g(rij) and its derivative:
5621 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5624 C where x=(rij-r0ij)/delta
5626 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5629 double precision rij,r0ij,eps0ij,fcont,fprimcont
5630 double precision x,x2,x4,delta
5634 if (x.lt.-1.0D0) then
5637 else if (x.le.1.0D0) then
5640 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5641 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5648 c------------------------------------------------------------------------------
5649 subroutine splinthet(theti,delta,ss,ssder)
5650 implicit real*8 (a-h,o-z)
5651 include 'DIMENSIONS'
5652 include 'COMMON.VAR'
5653 include 'COMMON.GEO'
5656 if (theti.gt.pipol) then
5657 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5659 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5664 c------------------------------------------------------------------------------
5665 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5667 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5668 double precision ksi,ksi2,ksi3,a1,a2,a3
5669 a1=fprim0*delta/(f1-f0)
5675 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5676 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5679 c------------------------------------------------------------------------------
5680 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5682 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5683 double precision ksi,ksi2,ksi3,a1,a2,a3
5688 a2=3*(f1x-f0x)-2*fprim0x*delta
5689 a3=fprim0x*delta-2*(f1x-f0x)
5690 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5693 C-----------------------------------------------------------------------------
5695 C-----------------------------------------------------------------------------
5696 subroutine etor(etors,edihcnstr)
5697 implicit real*8 (a-h,o-z)
5698 include 'DIMENSIONS'
5699 include 'COMMON.VAR'
5700 include 'COMMON.GEO'
5701 include 'COMMON.LOCAL'
5702 include 'COMMON.TORSION'
5703 include 'COMMON.INTERACT'
5704 include 'COMMON.DERIV'
5705 include 'COMMON.CHAIN'
5706 include 'COMMON.NAMES'
5707 include 'COMMON.IOUNITS'
5708 include 'COMMON.FFIELD'
5709 include 'COMMON.TORCNSTR'
5710 include 'COMMON.CONTROL'
5712 C Set lprn=.true. for debugging
5716 do i=iphi_start,iphi_end
5718 itori=itortyp(itype(i-2))
5719 itori1=itortyp(itype(i-1))
5722 C Proline-Proline pair is a special case...
5723 if (itori.eq.3 .and. itori1.eq.3) then
5724 if (phii.gt.-dwapi3) then
5726 fac=1.0D0/(1.0D0-cosphi)
5727 etorsi=v1(1,3,3)*fac
5728 etorsi=etorsi+etorsi
5729 etors=etors+etorsi-v1(1,3,3)
5730 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5731 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5734 v1ij=v1(j+1,itori,itori1)
5735 v2ij=v2(j+1,itori,itori1)
5738 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5739 if (energy_dec) etors_ii=etors_ii+
5740 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5741 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5745 v1ij=v1(j,itori,itori1)
5746 v2ij=v2(j,itori,itori1)
5749 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5750 if (energy_dec) etors_ii=etors_ii+
5751 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5752 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5755 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5758 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5759 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5760 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5761 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5762 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5764 ! 6/20/98 - dihedral angle constraints
5767 itori=idih_constr(i)
5770 if (difi.gt.drange(i)) then
5772 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5773 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5774 else if (difi.lt.-drange(i)) then
5776 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5777 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5779 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5780 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5782 ! write (iout,*) 'edihcnstr',edihcnstr
5785 c------------------------------------------------------------------------------
5786 subroutine etor_d(etors_d)
5790 c----------------------------------------------------------------------------
5792 subroutine etor(etors,edihcnstr)
5793 implicit real*8 (a-h,o-z)
5794 include 'DIMENSIONS'
5795 include 'COMMON.VAR'
5796 include 'COMMON.GEO'
5797 include 'COMMON.LOCAL'
5798 include 'COMMON.TORSION'
5799 include 'COMMON.INTERACT'
5800 include 'COMMON.DERIV'
5801 include 'COMMON.CHAIN'
5802 include 'COMMON.NAMES'
5803 include 'COMMON.IOUNITS'
5804 include 'COMMON.FFIELD'
5805 include 'COMMON.TORCNSTR'
5806 include 'COMMON.CONTROL'
5808 C Set lprn=.true. for debugging
5812 do i=iphi_start,iphi_end
5814 itori=itortyp(itype(i-2))
5815 itori1=itortyp(itype(i-1))
5818 C Regular cosine and sine terms
5819 do j=1,nterm(itori,itori1)
5820 v1ij=v1(j,itori,itori1)
5821 v2ij=v2(j,itori,itori1)
5824 etors=etors+v1ij*cosphi+v2ij*sinphi
5825 if (energy_dec) etors_ii=etors_ii+
5826 & v1ij*cosphi+v2ij*sinphi
5827 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5831 C E = SUM ----------------------------------- - v1
5832 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5834 cosphi=dcos(0.5d0*phii)
5835 sinphi=dsin(0.5d0*phii)
5836 do j=1,nlor(itori,itori1)
5837 vl1ij=vlor1(j,itori,itori1)
5838 vl2ij=vlor2(j,itori,itori1)
5839 vl3ij=vlor3(j,itori,itori1)
5840 pom=vl2ij*cosphi+vl3ij*sinphi
5841 pom1=1.0d0/(pom*pom+1.0d0)
5842 etors=etors+vl1ij*pom1
5843 if (energy_dec) etors_ii=etors_ii+
5846 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5848 C Subtract the constant term
5849 etors=etors-v0(itori,itori1)
5850 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5851 & 'etor',i,etors_ii-v0(itori,itori1)
5853 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5854 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5855 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5856 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5857 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5859 ! 6/20/98 - dihedral angle constraints
5861 c do i=1,ndih_constr
5862 do i=idihconstr_start,idihconstr_end
5863 itori=idih_constr(i)
5865 difi=pinorm(phii-phi0(i))
5866 if (difi.gt.drange(i)) then
5868 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5869 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5870 else if (difi.lt.-drange(i)) then
5872 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5873 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5877 c write (iout,*) "gloci", gloc(i-3,icg)
5878 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5879 cd & rad2deg*phi0(i), rad2deg*drange(i),
5880 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5882 cd write (iout,*) 'edihcnstr',edihcnstr
5885 c----------------------------------------------------------------------------
5886 subroutine etor_d(etors_d)
5887 C 6/23/01 Compute double torsional energy
5888 implicit real*8 (a-h,o-z)
5889 include 'DIMENSIONS'
5890 include 'COMMON.VAR'
5891 include 'COMMON.GEO'
5892 include 'COMMON.LOCAL'
5893 include 'COMMON.TORSION'
5894 include 'COMMON.INTERACT'
5895 include 'COMMON.DERIV'
5896 include 'COMMON.CHAIN'
5897 include 'COMMON.NAMES'
5898 include 'COMMON.IOUNITS'
5899 include 'COMMON.FFIELD'
5900 include 'COMMON.TORCNSTR'
5901 include 'COMMON.CONTROL'
5903 C Set lprn=.true. for debugging
5907 do i=iphid_start,iphid_end
5909 itori=itortyp(itype(i-2))
5910 itori1=itortyp(itype(i-1))
5911 itori2=itortyp(itype(i))
5916 do j=1,ntermd_1(itori,itori1,itori2)
5917 v1cij=v1c(1,j,itori,itori1,itori2)
5918 v1sij=v1s(1,j,itori,itori1,itori2)
5919 v2cij=v1c(2,j,itori,itori1,itori2)
5920 v2sij=v1s(2,j,itori,itori1,itori2)
5921 cosphi1=dcos(j*phii)
5922 sinphi1=dsin(j*phii)
5923 cosphi2=dcos(j*phii1)
5924 sinphi2=dsin(j*phii1)
5925 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5926 & v2cij*cosphi2+v2sij*sinphi2
5927 if (energy_dec) etors_d_ii=etors_d_ii+
5928 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
5929 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5930 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5932 do k=2,ntermd_2(itori,itori1,itori2)
5934 v1cdij = v2c(k,l,itori,itori1,itori2)
5935 v2cdij = v2c(l,k,itori,itori1,itori2)
5936 v1sdij = v2s(k,l,itori,itori1,itori2)
5937 v2sdij = v2s(l,k,itori,itori1,itori2)
5938 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5939 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5940 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5941 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5942 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5943 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5944 if (energy_dec) etors_d_ii=etors_d_ii+
5945 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5946 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5947 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5948 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5949 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5950 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5953 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5954 & 'etor_d',i,etors_d_ii
5955 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5956 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5957 c write (iout,*) "gloci", gloc(i-3,icg)
5962 c------------------------------------------------------------------------------
5963 subroutine eback_sc_corr(esccor)
5964 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5965 c conformational states; temporarily implemented as differences
5966 c between UNRES torsional potentials (dependent on three types of
5967 c residues) and the torsional potentials dependent on all 20 types
5968 c of residues computed from AM1 energy surfaces of terminally-blocked
5969 c amino-acid residues.
5970 implicit real*8 (a-h,o-z)
5971 include 'DIMENSIONS'
5972 include 'COMMON.VAR'
5973 include 'COMMON.GEO'
5974 include 'COMMON.LOCAL'
5975 include 'COMMON.TORSION'
5976 include 'COMMON.SCCOR'
5977 include 'COMMON.INTERACT'
5978 include 'COMMON.DERIV'
5979 include 'COMMON.CHAIN'
5980 include 'COMMON.NAMES'
5981 include 'COMMON.IOUNITS'
5982 include 'COMMON.FFIELD'
5983 include 'COMMON.CONTROL'
5985 C Set lprn=.true. for debugging
5988 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5990 do i=itau_start,itau_end
5993 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5994 isccori=isccortyp(itype(i-2))
5995 isccori1=isccortyp(itype(i-1))
5998 cccc Added 9 May 2012
5999 cc Tauangle is torsional engle depending on the value of first digit
6000 c(see comment below)
6001 cc Omicron is flat angle depending on the value of first digit
6002 c(see comment below)
6003 C print *,i,tauangle(1,i)
6005 do intertyp=1,3 !intertyp
6007 cc Added 09 May 2012 (Adasko)
6008 cc Intertyp means interaction type of backbone mainchain correlation:
6009 c 1 = SC...Ca...Ca...Ca
6010 c 2 = Ca...Ca...Ca...SC
6011 c 3 = SC...Ca...Ca...SCi
6013 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6014 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6015 & (itype(i-1).eq.21)))
6016 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6017 & .or.(itype(i-2).eq.21)))
6018 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6019 & (itype(i-1).eq.21)))) cycle
6020 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6021 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6023 do j=1,nterm_sccor(isccori,isccori1)
6024 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6025 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6026 cosphi=dcos(j*tauangle(intertyp,i))
6027 sinphi=dsin(j*tauangle(intertyp,i))
6028 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
6029 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6030 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6032 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)')
6033 & 'esccor',i,intertyp,esccor_ii
6034 C print *,i,tauangle(1,i),gloci
6035 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6036 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6037 c &gloc_sc(intertyp,i-3,icg)
6039 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6040 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6041 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6042 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6043 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6047 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc_sc(2,i,icg),
6048 c & gloc_sc(3,i,icg)
6052 c----------------------------------------------------------------------------
6053 subroutine multibody(ecorr)
6054 C This subroutine calculates multi-body contributions to energy following
6055 C the idea of Skolnick et al. If side chains I and J make a contact and
6056 C at the same time side chains I+1 and J+1 make a contact, an extra
6057 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6058 implicit real*8 (a-h,o-z)
6059 include 'DIMENSIONS'
6060 include 'COMMON.IOUNITS'
6061 include 'COMMON.DERIV'
6062 include 'COMMON.INTERACT'
6063 include 'COMMON.CONTACTS'
6064 double precision gx(3),gx1(3)
6067 C Set lprn=.true. for debugging
6071 write (iout,'(a)') 'Contact function values:'
6073 write (iout,'(i2,20(1x,i2,f10.5))')
6074 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6089 num_conti=num_cont(i)
6090 num_conti1=num_cont(i1)
6095 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6096 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6097 cd & ' ishift=',ishift
6098 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6099 C The system gains extra energy.
6100 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6101 endif ! j1==j+-ishift
6110 c------------------------------------------------------------------------------
6111 double precision function esccorr(i,j,k,l,jj,kk)
6112 implicit real*8 (a-h,o-z)
6113 include 'DIMENSIONS'
6114 include 'COMMON.IOUNITS'
6115 include 'COMMON.DERIV'
6116 include 'COMMON.INTERACT'
6117 include 'COMMON.CONTACTS'
6118 double precision gx(3),gx1(3)
6123 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6124 C Calculate the multi-body contribution to energy.
6125 C Calculate multi-body contributions to the gradient.
6126 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6127 cd & k,l,(gacont(m,kk,k),m=1,3)
6129 gx(m) =ekl*gacont(m,jj,i)
6130 gx1(m)=eij*gacont(m,kk,k)
6131 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6132 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6133 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6134 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6138 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6143 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6149 c------------------------------------------------------------------------------
6150 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6151 C This subroutine calculates multi-body contributions to hydrogen-bonding
6152 implicit real*8 (a-h,o-z)
6153 include 'DIMENSIONS'
6154 include 'COMMON.IOUNITS'
6157 parameter (max_cont=maxconts)
6158 parameter (max_dim=26)
6159 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6160 double precision zapas(max_dim,maxconts,max_fg_procs),
6161 & zapas_recv(max_dim,maxconts,max_fg_procs)
6162 common /przechowalnia/ zapas
6163 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6164 & status_array(MPI_STATUS_SIZE,maxconts*2)
6166 include 'COMMON.SETUP'
6167 include 'COMMON.FFIELD'
6168 include 'COMMON.DERIV'
6169 include 'COMMON.INTERACT'
6170 include 'COMMON.CONTACTS'
6171 include 'COMMON.CONTROL'
6172 include 'COMMON.LOCAL'
6173 double precision gx(3),gx1(3),time00
6176 C Set lprn=.true. for debugging
6181 if (nfgtasks.le.1) goto 30
6183 write (iout,'(a)') 'Contact function values before RECEIVE:'
6185 write (iout,'(2i3,50(1x,i2,f5.2))')
6186 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6187 & j=1,num_cont_hb(i))
6191 do i=1,ntask_cont_from
6194 do i=1,ntask_cont_to
6197 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6199 C Make the list of contacts to send to send to other procesors
6200 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6202 do i=iturn3_start,iturn3_end
6203 c write (iout,*) "make contact list turn3",i," num_cont",
6205 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6207 do i=iturn4_start,iturn4_end
6208 c write (iout,*) "make contact list turn4",i," num_cont",
6210 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6214 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6216 do j=1,num_cont_hb(i)
6219 iproc=iint_sent_local(k,jjc,ii)
6220 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6221 if (iproc.gt.0) then
6222 ncont_sent(iproc)=ncont_sent(iproc)+1
6223 nn=ncont_sent(iproc)
6225 zapas(2,nn,iproc)=jjc
6226 zapas(3,nn,iproc)=facont_hb(j,i)
6227 zapas(4,nn,iproc)=ees0p(j,i)
6228 zapas(5,nn,iproc)=ees0m(j,i)
6229 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6230 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6231 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6232 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6233 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6234 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6235 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6236 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6237 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6238 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6239 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6240 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6241 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6242 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6243 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6244 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6245 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6246 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6247 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6248 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6249 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6256 & "Numbers of contacts to be sent to other processors",
6257 & (ncont_sent(i),i=1,ntask_cont_to)
6258 write (iout,*) "Contacts sent"
6259 do ii=1,ntask_cont_to
6261 iproc=itask_cont_to(ii)
6262 write (iout,*) nn," contacts to processor",iproc,
6263 & " of CONT_TO_COMM group"
6265 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6273 CorrelID1=nfgtasks+fg_rank+1
6275 C Receive the numbers of needed contacts from other processors
6276 do ii=1,ntask_cont_from
6277 iproc=itask_cont_from(ii)
6279 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6280 & FG_COMM,req(ireq),IERR)
6282 c write (iout,*) "IRECV ended"
6284 C Send the number of contacts needed by other processors
6285 do ii=1,ntask_cont_to
6286 iproc=itask_cont_to(ii)
6288 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6289 & FG_COMM,req(ireq),IERR)
6291 c write (iout,*) "ISEND ended"
6292 c write (iout,*) "number of requests (nn)",ireq
6295 & call MPI_Waitall(ireq,req,status_array,ierr)
6297 c & "Numbers of contacts to be received from other processors",
6298 c & (ncont_recv(i),i=1,ntask_cont_from)
6302 do ii=1,ntask_cont_from
6303 iproc=itask_cont_from(ii)
6305 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6306 c & " of CONT_TO_COMM group"
6310 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6311 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6312 c write (iout,*) "ireq,req",ireq,req(ireq)
6315 C Send the contacts to processors that need them
6316 do ii=1,ntask_cont_to
6317 iproc=itask_cont_to(ii)
6319 c write (iout,*) nn," contacts to processor",iproc,
6320 c & " of CONT_TO_COMM group"
6323 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6324 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6325 c write (iout,*) "ireq,req",ireq,req(ireq)
6327 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6331 c write (iout,*) "number of requests (contacts)",ireq
6332 c write (iout,*) "req",(req(i),i=1,4)
6335 & call MPI_Waitall(ireq,req,status_array,ierr)
6336 do iii=1,ntask_cont_from
6337 iproc=itask_cont_from(iii)
6340 write (iout,*) "Received",nn," contacts from processor",iproc,
6341 & " of CONT_FROM_COMM group"
6344 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6349 ii=zapas_recv(1,i,iii)
6350 c Flag the received contacts to prevent double-counting
6351 jj=-zapas_recv(2,i,iii)
6352 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6354 nnn=num_cont_hb(ii)+1
6357 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6358 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6359 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6360 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6361 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6362 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6363 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6364 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6365 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6366 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6367 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6368 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6369 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6370 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6371 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6372 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6373 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6374 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6375 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6376 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6377 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6378 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6379 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6380 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6385 write (iout,'(a)') 'Contact function values after receive:'
6387 write (iout,'(2i3,50(1x,i3,f5.2))')
6388 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6389 & j=1,num_cont_hb(i))
6396 write (iout,'(a)') 'Contact function values:'
6398 write (iout,'(2i3,50(1x,i3,f5.2))')
6399 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6400 & j=1,num_cont_hb(i))
6404 C Remove the loop below after debugging !!!
6411 C Calculate the local-electrostatic correlation terms
6412 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6414 num_conti=num_cont_hb(i)
6415 num_conti1=num_cont_hb(i+1)
6422 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6423 c & ' jj=',jj,' kk=',kk
6424 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6425 & .or. j.lt.0 .and. j1.gt.0) .and.
6426 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6427 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6428 C The system gains extra energy.
6429 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6430 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6431 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6433 else if (j1.eq.j) then
6434 C Contacts I-J and I-(J+1) occur simultaneously.
6435 C The system loses extra energy.
6436 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6441 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6442 c & ' jj=',jj,' kk=',kk
6444 C Contacts I-J and (I+1)-J occur simultaneously.
6445 C The system loses extra energy.
6446 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6453 c------------------------------------------------------------------------------
6454 subroutine add_hb_contact(ii,jj,itask)
6455 implicit real*8 (a-h,o-z)
6456 include "DIMENSIONS"
6457 include "COMMON.IOUNITS"
6460 parameter (max_cont=maxconts)
6461 parameter (max_dim=26)
6462 include "COMMON.CONTACTS"
6463 double precision zapas(max_dim,maxconts,max_fg_procs),
6464 & zapas_recv(max_dim,maxconts,max_fg_procs)
6465 common /przechowalnia/ zapas
6466 integer i,j,ii,jj,iproc,itask(4),nn
6467 c write (iout,*) "itask",itask
6470 if (iproc.gt.0) then
6471 do j=1,num_cont_hb(ii)
6473 c write (iout,*) "i",ii," j",jj," jjc",jjc
6475 ncont_sent(iproc)=ncont_sent(iproc)+1
6476 nn=ncont_sent(iproc)
6477 zapas(1,nn,iproc)=ii
6478 zapas(2,nn,iproc)=jjc
6479 zapas(3,nn,iproc)=facont_hb(j,ii)
6480 zapas(4,nn,iproc)=ees0p(j,ii)
6481 zapas(5,nn,iproc)=ees0m(j,ii)
6482 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6483 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6484 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6485 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6486 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6487 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6488 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6489 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6490 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6491 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6492 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6493 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6494 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6495 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6496 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6497 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6498 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6499 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6500 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6501 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6502 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6510 c------------------------------------------------------------------------------
6511 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6513 C This subroutine calculates multi-body contributions to hydrogen-bonding
6514 implicit real*8 (a-h,o-z)
6515 include 'DIMENSIONS'
6516 include 'COMMON.IOUNITS'
6519 parameter (max_cont=maxconts)
6520 parameter (max_dim=70)
6521 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6522 double precision zapas(max_dim,maxconts,max_fg_procs),
6523 & zapas_recv(max_dim,maxconts,max_fg_procs)
6524 common /przechowalnia/ zapas
6525 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6526 & status_array(MPI_STATUS_SIZE,maxconts*2)
6528 include 'COMMON.SETUP'
6529 include 'COMMON.FFIELD'
6530 include 'COMMON.DERIV'
6531 include 'COMMON.LOCAL'
6532 include 'COMMON.INTERACT'
6533 include 'COMMON.CONTACTS'
6534 include 'COMMON.CHAIN'
6535 include 'COMMON.CONTROL'
6536 double precision gx(3),gx1(3)
6537 integer num_cont_hb_old(maxres)
6539 double precision eello4,eello5,eelo6,eello_turn6
6540 external eello4,eello5,eello6,eello_turn6
6541 C Set lprn=.true. for debugging
6546 num_cont_hb_old(i)=num_cont_hb(i)
6550 if (nfgtasks.le.1) goto 30
6552 write (iout,'(a)') 'Contact function values before RECEIVE:'
6554 write (iout,'(2i3,50(1x,i2,f5.2))')
6555 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6556 & j=1,num_cont_hb(i))
6560 do i=1,ntask_cont_from
6563 do i=1,ntask_cont_to
6566 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6568 C Make the list of contacts to send to send to other procesors
6569 do i=iturn3_start,iturn3_end
6570 c write (iout,*) "make contact list turn3",i," num_cont",
6572 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6574 do i=iturn4_start,iturn4_end
6575 c write (iout,*) "make contact list turn4",i," num_cont",
6577 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6581 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6583 do j=1,num_cont_hb(i)
6586 iproc=iint_sent_local(k,jjc,ii)
6587 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6588 if (iproc.ne.0) then
6589 ncont_sent(iproc)=ncont_sent(iproc)+1
6590 nn=ncont_sent(iproc)
6592 zapas(2,nn,iproc)=jjc
6593 zapas(3,nn,iproc)=d_cont(j,i)
6597 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6602 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6610 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6621 & "Numbers of contacts to be sent to other processors",
6622 & (ncont_sent(i),i=1,ntask_cont_to)
6623 write (iout,*) "Contacts sent"
6624 do ii=1,ntask_cont_to
6626 iproc=itask_cont_to(ii)
6627 write (iout,*) nn," contacts to processor",iproc,
6628 & " of CONT_TO_COMM group"
6630 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6638 CorrelID1=nfgtasks+fg_rank+1
6640 C Receive the numbers of needed contacts from other processors
6641 do ii=1,ntask_cont_from
6642 iproc=itask_cont_from(ii)
6644 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6645 & FG_COMM,req(ireq),IERR)
6647 c write (iout,*) "IRECV ended"
6649 C Send the number of contacts needed by other processors
6650 do ii=1,ntask_cont_to
6651 iproc=itask_cont_to(ii)
6653 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6654 & FG_COMM,req(ireq),IERR)
6656 c write (iout,*) "ISEND ended"
6657 c write (iout,*) "number of requests (nn)",ireq
6660 & call MPI_Waitall(ireq,req,status_array,ierr)
6662 c & "Numbers of contacts to be received from other processors",
6663 c & (ncont_recv(i),i=1,ntask_cont_from)
6667 do ii=1,ntask_cont_from
6668 iproc=itask_cont_from(ii)
6670 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6671 c & " of CONT_TO_COMM group"
6675 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6676 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6677 c write (iout,*) "ireq,req",ireq,req(ireq)
6680 C Send the contacts to processors that need them
6681 do ii=1,ntask_cont_to
6682 iproc=itask_cont_to(ii)
6684 c write (iout,*) nn," contacts to processor",iproc,
6685 c & " of CONT_TO_COMM group"
6688 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6689 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6690 c write (iout,*) "ireq,req",ireq,req(ireq)
6692 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6696 c write (iout,*) "number of requests (contacts)",ireq
6697 c write (iout,*) "req",(req(i),i=1,4)
6700 & call MPI_Waitall(ireq,req,status_array,ierr)
6701 do iii=1,ntask_cont_from
6702 iproc=itask_cont_from(iii)
6705 write (iout,*) "Received",nn," contacts from processor",iproc,
6706 & " of CONT_FROM_COMM group"
6709 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6714 ii=zapas_recv(1,i,iii)
6715 c Flag the received contacts to prevent double-counting
6716 jj=-zapas_recv(2,i,iii)
6717 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6719 nnn=num_cont_hb(ii)+1
6722 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6726 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6731 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6739 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6748 write (iout,'(a)') 'Contact function values after receive:'
6750 write (iout,'(2i3,50(1x,i3,5f6.3))')
6751 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6752 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6759 write (iout,'(a)') 'Contact function values:'
6761 write (iout,'(2i3,50(1x,i2,5f6.3))')
6762 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6763 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6769 C Remove the loop below after debugging !!!
6776 C Calculate the dipole-dipole interaction energies
6777 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6778 do i=iatel_s,iatel_e+1
6779 num_conti=num_cont_hb(i)
6788 C Calculate the local-electrostatic correlation terms
6789 c write (iout,*) "gradcorr5 in eello5 before loop"
6791 c write (iout,'(i5,3f10.5)')
6792 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6794 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6795 c write (iout,*) "corr loop i",i
6797 num_conti=num_cont_hb(i)
6798 num_conti1=num_cont_hb(i+1)
6805 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6806 c & ' jj=',jj,' kk=',kk
6807 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6808 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6809 & .or. j.lt.0 .and. j1.gt.0) .and.
6810 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6811 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6812 C The system gains extra energy.
6814 sqd1=dsqrt(d_cont(jj,i))
6815 sqd2=dsqrt(d_cont(kk,i1))
6816 sred_geom = sqd1*sqd2
6817 IF (sred_geom.lt.cutoff_corr) THEN
6818 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6820 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6821 cd & ' jj=',jj,' kk=',kk
6822 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6823 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6825 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6826 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6829 cd write (iout,*) 'sred_geom=',sred_geom,
6830 cd & ' ekont=',ekont,' fprim=',fprimcont,
6831 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6832 cd write (iout,*) "g_contij",g_contij
6833 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6834 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6835 call calc_eello(i,jp,i+1,jp1,jj,kk)
6836 if (wcorr4.gt.0.0d0)
6837 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6838 if (energy_dec.and.wcorr4.gt.0.0d0)
6839 1 write (iout,'(a6,4i5,0pf7.3)')
6840 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6841 c write (iout,*) "gradcorr5 before eello5"
6843 c write (iout,'(i5,3f10.5)')
6844 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6846 if (wcorr5.gt.0.0d0)
6847 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6848 c write (iout,*) "gradcorr5 after eello5"
6850 c write (iout,'(i5,3f10.5)')
6851 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6853 if (energy_dec.and.wcorr5.gt.0.0d0)
6854 1 write (iout,'(a6,4i5,0pf7.3)')
6855 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6856 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6857 cd write(2,*)'ijkl',i,jp,i+1,jp1
6858 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6859 & .or. wturn6.eq.0.0d0))then
6860 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6861 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6862 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6863 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6864 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6865 cd & 'ecorr6=',ecorr6
6866 cd write (iout,'(4e15.5)') sred_geom,
6867 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6868 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6869 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6870 else if (wturn6.gt.0.0d0
6871 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6872 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6873 eturn6=eturn6+eello_turn6(i,jj,kk)
6874 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6875 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6876 cd write (2,*) 'multibody_eello:eturn6',eturn6
6885 num_cont_hb(i)=num_cont_hb_old(i)
6887 c write (iout,*) "gradcorr5 in eello5"
6889 c write (iout,'(i5,3f10.5)')
6890 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6894 c------------------------------------------------------------------------------
6895 subroutine add_hb_contact_eello(ii,jj,itask)
6896 implicit real*8 (a-h,o-z)
6897 include "DIMENSIONS"
6898 include "COMMON.IOUNITS"
6901 parameter (max_cont=maxconts)
6902 parameter (max_dim=70)
6903 include "COMMON.CONTACTS"
6904 double precision zapas(max_dim,maxconts,max_fg_procs),
6905 & zapas_recv(max_dim,maxconts,max_fg_procs)
6906 common /przechowalnia/ zapas
6907 integer i,j,ii,jj,iproc,itask(4),nn
6908 c write (iout,*) "itask",itask
6911 if (iproc.gt.0) then
6912 do j=1,num_cont_hb(ii)
6914 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6916 ncont_sent(iproc)=ncont_sent(iproc)+1
6917 nn=ncont_sent(iproc)
6918 zapas(1,nn,iproc)=ii
6919 zapas(2,nn,iproc)=jjc
6920 zapas(3,nn,iproc)=d_cont(j,ii)
6924 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6929 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6937 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6949 c------------------------------------------------------------------------------
6950 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6951 implicit real*8 (a-h,o-z)
6952 include 'DIMENSIONS'
6953 include 'COMMON.IOUNITS'
6954 include 'COMMON.DERIV'
6955 include 'COMMON.INTERACT'
6956 include 'COMMON.CONTACTS'
6957 double precision gx(3),gx1(3)
6967 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6968 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6969 C Following 4 lines for diagnostics.
6974 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6975 c & 'Contacts ',i,j,
6976 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6977 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6979 C Calculate the multi-body contribution to energy.
6980 c ecorr=ecorr+ekont*ees
6981 C Calculate multi-body contributions to the gradient.
6982 coeffpees0pij=coeffp*ees0pij
6983 coeffmees0mij=coeffm*ees0mij
6984 coeffpees0pkl=coeffp*ees0pkl
6985 coeffmees0mkl=coeffm*ees0mkl
6987 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6988 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6989 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6990 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6991 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6992 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6993 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6994 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6995 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6996 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6997 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6998 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6999 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7000 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7001 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7002 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7003 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7004 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7005 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7006 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7007 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7008 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7009 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7010 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7011 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7016 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7017 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7018 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7019 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7024 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7025 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7026 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7027 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7030 c write (iout,*) "ehbcorr",ekont*ees
7035 C---------------------------------------------------------------------------
7036 subroutine dipole(i,j,jj)
7037 implicit real*8 (a-h,o-z)
7038 include 'DIMENSIONS'
7039 include 'COMMON.IOUNITS'
7040 include 'COMMON.CHAIN'
7041 include 'COMMON.FFIELD'
7042 include 'COMMON.DERIV'
7043 include 'COMMON.INTERACT'
7044 include 'COMMON.CONTACTS'
7045 include 'COMMON.TORSION'
7046 include 'COMMON.VAR'
7047 include 'COMMON.GEO'
7048 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7050 iti1 = itortyp(itype(i+1))
7051 if (j.lt.nres-1) then
7052 itj1 = itortyp(itype(j+1))
7057 dipi(iii,1)=Ub2(iii,i)
7058 dipderi(iii)=Ub2der(iii,i)
7059 dipi(iii,2)=b1(iii,iti1)
7060 dipj(iii,1)=Ub2(iii,j)
7061 dipderj(iii)=Ub2der(iii,j)
7062 dipj(iii,2)=b1(iii,itj1)
7066 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7069 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7076 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7080 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7085 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7086 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7088 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7090 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7092 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7097 C---------------------------------------------------------------------------
7098 subroutine calc_eello(i,j,k,l,jj,kk)
7100 C This subroutine computes matrices and vectors needed to calculate
7101 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7103 implicit real*8 (a-h,o-z)
7104 include 'DIMENSIONS'
7105 include 'COMMON.IOUNITS'
7106 include 'COMMON.CHAIN'
7107 include 'COMMON.DERIV'
7108 include 'COMMON.INTERACT'
7109 include 'COMMON.CONTACTS'
7110 include 'COMMON.TORSION'
7111 include 'COMMON.VAR'
7112 include 'COMMON.GEO'
7113 include 'COMMON.FFIELD'
7114 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7115 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7118 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7119 cd & ' jj=',jj,' kk=',kk
7120 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7121 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7122 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7125 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7126 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7129 call transpose2(aa1(1,1),aa1t(1,1))
7130 call transpose2(aa2(1,1),aa2t(1,1))
7133 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7134 & aa1tder(1,1,lll,kkk))
7135 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7136 & aa2tder(1,1,lll,kkk))
7140 C parallel orientation of the two CA-CA-CA frames.
7142 iti=itortyp(itype(i))
7146 itk1=itortyp(itype(k+1))
7147 itj=itortyp(itype(j))
7148 if (l.lt.nres-1) then
7149 itl1=itortyp(itype(l+1))
7153 C A1 kernel(j+1) A2T
7155 cd write (iout,'(3f10.5,5x,3f10.5)')
7156 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7158 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7159 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7160 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7161 C Following matrices are needed only for 6-th order cumulants
7162 IF (wcorr6.gt.0.0d0) THEN
7163 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7164 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7165 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7166 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7167 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7168 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7169 & ADtEAderx(1,1,1,1,1,1))
7171 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7172 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7173 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7174 & ADtEA1derx(1,1,1,1,1,1))
7176 C End 6-th order cumulants
7179 cd write (2,*) 'In calc_eello6'
7181 cd write (2,*) 'iii=',iii
7183 cd write (2,*) 'kkk=',kkk
7185 cd write (2,'(3(2f10.5),5x)')
7186 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7191 call transpose2(EUgder(1,1,k),auxmat(1,1))
7192 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7193 call transpose2(EUg(1,1,k),auxmat(1,1))
7194 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7195 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7199 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7200 & EAEAderx(1,1,lll,kkk,iii,1))
7204 C A1T kernel(i+1) A2
7205 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7206 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7207 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7208 C Following matrices are needed only for 6-th order cumulants
7209 IF (wcorr6.gt.0.0d0) THEN
7210 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7211 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7212 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7213 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7214 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7215 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7216 & ADtEAderx(1,1,1,1,1,2))
7217 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7218 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7219 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7220 & ADtEA1derx(1,1,1,1,1,2))
7222 C End 6-th order cumulants
7223 call transpose2(EUgder(1,1,l),auxmat(1,1))
7224 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7225 call transpose2(EUg(1,1,l),auxmat(1,1))
7226 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7227 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7231 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7232 & EAEAderx(1,1,lll,kkk,iii,2))
7237 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7238 C They are needed only when the fifth- or the sixth-order cumulants are
7240 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7241 call transpose2(AEA(1,1,1),auxmat(1,1))
7242 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7243 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7244 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7245 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7246 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7247 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7248 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7249 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7250 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7251 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7252 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7253 call transpose2(AEA(1,1,2),auxmat(1,1))
7254 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7255 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7256 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7257 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7258 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7259 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7260 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7261 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7262 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7263 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7264 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7265 C Calculate the Cartesian derivatives of the vectors.
7269 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7270 call matvec2(auxmat(1,1),b1(1,iti),
7271 & AEAb1derx(1,lll,kkk,iii,1,1))
7272 call matvec2(auxmat(1,1),Ub2(1,i),
7273 & AEAb2derx(1,lll,kkk,iii,1,1))
7274 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7275 & AEAb1derx(1,lll,kkk,iii,2,1))
7276 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7277 & AEAb2derx(1,lll,kkk,iii,2,1))
7278 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7279 call matvec2(auxmat(1,1),b1(1,itj),
7280 & AEAb1derx(1,lll,kkk,iii,1,2))
7281 call matvec2(auxmat(1,1),Ub2(1,j),
7282 & AEAb2derx(1,lll,kkk,iii,1,2))
7283 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7284 & AEAb1derx(1,lll,kkk,iii,2,2))
7285 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7286 & AEAb2derx(1,lll,kkk,iii,2,2))
7293 C Antiparallel orientation of the two CA-CA-CA frames.
7295 iti=itortyp(itype(i))
7299 itk1=itortyp(itype(k+1))
7300 itl=itortyp(itype(l))
7301 itj=itortyp(itype(j))
7302 if (j.lt.nres-1) then
7303 itj1=itortyp(itype(j+1))
7307 C A2 kernel(j-1)T A1T
7308 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7309 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7310 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7311 C Following matrices are needed only for 6-th order cumulants
7312 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7313 & j.eq.i+4 .and. l.eq.i+3)) THEN
7314 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7315 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7316 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7317 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7318 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7319 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7320 & ADtEAderx(1,1,1,1,1,1))
7321 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7322 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7323 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7324 & ADtEA1derx(1,1,1,1,1,1))
7326 C End 6-th order cumulants
7327 call transpose2(EUgder(1,1,k),auxmat(1,1))
7328 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7329 call transpose2(EUg(1,1,k),auxmat(1,1))
7330 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7331 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7335 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7336 & EAEAderx(1,1,lll,kkk,iii,1))
7340 C A2T kernel(i+1)T A1
7341 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7342 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7343 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7344 C Following matrices are needed only for 6-th order cumulants
7345 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7346 & j.eq.i+4 .and. l.eq.i+3)) THEN
7347 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7348 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7349 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7350 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7351 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7352 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7353 & ADtEAderx(1,1,1,1,1,2))
7354 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7355 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7356 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7357 & ADtEA1derx(1,1,1,1,1,2))
7359 C End 6-th order cumulants
7360 call transpose2(EUgder(1,1,j),auxmat(1,1))
7361 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7362 call transpose2(EUg(1,1,j),auxmat(1,1))
7363 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7364 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7368 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7369 & EAEAderx(1,1,lll,kkk,iii,2))
7374 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7375 C They are needed only when the fifth- or the sixth-order cumulants are
7377 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7378 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7379 call transpose2(AEA(1,1,1),auxmat(1,1))
7380 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7381 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7382 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7383 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7384 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7385 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7386 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7387 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7388 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7389 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7390 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7391 call transpose2(AEA(1,1,2),auxmat(1,1))
7392 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7393 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7394 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7395 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7396 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7397 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7398 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7399 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7400 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7401 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7402 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7403 C Calculate the Cartesian derivatives of the vectors.
7407 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7408 call matvec2(auxmat(1,1),b1(1,iti),
7409 & AEAb1derx(1,lll,kkk,iii,1,1))
7410 call matvec2(auxmat(1,1),Ub2(1,i),
7411 & AEAb2derx(1,lll,kkk,iii,1,1))
7412 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7413 & AEAb1derx(1,lll,kkk,iii,2,1))
7414 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7415 & AEAb2derx(1,lll,kkk,iii,2,1))
7416 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7417 call matvec2(auxmat(1,1),b1(1,itl),
7418 & AEAb1derx(1,lll,kkk,iii,1,2))
7419 call matvec2(auxmat(1,1),Ub2(1,l),
7420 & AEAb2derx(1,lll,kkk,iii,1,2))
7421 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7422 & AEAb1derx(1,lll,kkk,iii,2,2))
7423 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7424 & AEAb2derx(1,lll,kkk,iii,2,2))
7433 C---------------------------------------------------------------------------
7434 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7435 & KK,KKderg,AKA,AKAderg,AKAderx)
7439 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7440 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7441 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7446 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7448 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7451 cd if (lprn) write (2,*) 'In kernel'
7453 cd if (lprn) write (2,*) 'kkk=',kkk
7455 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7456 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7458 cd write (2,*) 'lll=',lll
7459 cd write (2,*) 'iii=1'
7461 cd write (2,'(3(2f10.5),5x)')
7462 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7465 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7466 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7468 cd write (2,*) 'lll=',lll
7469 cd write (2,*) 'iii=2'
7471 cd write (2,'(3(2f10.5),5x)')
7472 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7479 C---------------------------------------------------------------------------
7480 double precision function eello4(i,j,k,l,jj,kk)
7481 implicit real*8 (a-h,o-z)
7482 include 'DIMENSIONS'
7483 include 'COMMON.IOUNITS'
7484 include 'COMMON.CHAIN'
7485 include 'COMMON.DERIV'
7486 include 'COMMON.INTERACT'
7487 include 'COMMON.CONTACTS'
7488 include 'COMMON.TORSION'
7489 include 'COMMON.VAR'
7490 include 'COMMON.GEO'
7491 double precision pizda(2,2),ggg1(3),ggg2(3)
7492 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7496 cd print *,'eello4:',i,j,k,l,jj,kk
7497 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7498 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7499 cold eij=facont_hb(jj,i)
7500 cold ekl=facont_hb(kk,k)
7502 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7503 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7504 gcorr_loc(k-1)=gcorr_loc(k-1)
7505 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7507 gcorr_loc(l-1)=gcorr_loc(l-1)
7508 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7510 gcorr_loc(j-1)=gcorr_loc(j-1)
7511 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7516 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7517 & -EAEAderx(2,2,lll,kkk,iii,1)
7518 cd derx(lll,kkk,iii)=0.0d0
7522 cd gcorr_loc(l-1)=0.0d0
7523 cd gcorr_loc(j-1)=0.0d0
7524 cd gcorr_loc(k-1)=0.0d0
7526 cd write (iout,*)'Contacts have occurred for peptide groups',
7527 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7528 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7529 if (j.lt.nres-1) then
7536 if (l.lt.nres-1) then
7544 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7545 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7546 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7547 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7548 cgrad ghalf=0.5d0*ggg1(ll)
7549 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7550 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7551 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7552 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7553 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7554 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7555 cgrad ghalf=0.5d0*ggg2(ll)
7556 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7557 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7558 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7559 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7560 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7561 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7565 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7570 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7575 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7580 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7584 cd write (2,*) iii,gcorr_loc(iii)
7587 cd write (2,*) 'ekont',ekont
7588 cd write (iout,*) 'eello4',ekont*eel4
7591 C---------------------------------------------------------------------------
7592 double precision function eello5(i,j,k,l,jj,kk)
7593 implicit real*8 (a-h,o-z)
7594 include 'DIMENSIONS'
7595 include 'COMMON.IOUNITS'
7596 include 'COMMON.CHAIN'
7597 include 'COMMON.DERIV'
7598 include 'COMMON.INTERACT'
7599 include 'COMMON.CONTACTS'
7600 include 'COMMON.TORSION'
7601 include 'COMMON.VAR'
7602 include 'COMMON.GEO'
7603 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7604 double precision ggg1(3),ggg2(3)
7605 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7610 C /l\ / \ \ / \ / \ / C
7611 C / \ / \ \ / \ / \ / C
7612 C j| o |l1 | o | o| o | | o |o C
7613 C \ |/k\| |/ \| / |/ \| |/ \| C
7614 C \i/ \ / \ / / \ / \ C
7616 C (I) (II) (III) (IV) C
7618 C eello5_1 eello5_2 eello5_3 eello5_4 C
7620 C Antiparallel chains C
7623 C /j\ / \ \ / \ / \ / C
7624 C / \ / \ \ / \ / \ / C
7625 C j1| o |l | o | o| o | | o |o C
7626 C \ |/k\| |/ \| / |/ \| |/ \| C
7627 C \i/ \ / \ / / \ / \ C
7629 C (I) (II) (III) (IV) C
7631 C eello5_1 eello5_2 eello5_3 eello5_4 C
7633 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7635 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7636 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7641 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7643 itk=itortyp(itype(k))
7644 itl=itortyp(itype(l))
7645 itj=itortyp(itype(j))
7650 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7651 cd & eel5_3_num,eel5_4_num)
7655 derx(lll,kkk,iii)=0.0d0
7659 cd eij=facont_hb(jj,i)
7660 cd ekl=facont_hb(kk,k)
7662 cd write (iout,*)'Contacts have occurred for peptide groups',
7663 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7665 C Contribution from the graph I.
7666 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7667 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7668 call transpose2(EUg(1,1,k),auxmat(1,1))
7669 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7670 vv(1)=pizda(1,1)-pizda(2,2)
7671 vv(2)=pizda(1,2)+pizda(2,1)
7672 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7673 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7674 C Explicit gradient in virtual-dihedral angles.
7675 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7676 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7677 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7678 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7679 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7680 vv(1)=pizda(1,1)-pizda(2,2)
7681 vv(2)=pizda(1,2)+pizda(2,1)
7682 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7683 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7684 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7685 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7686 vv(1)=pizda(1,1)-pizda(2,2)
7687 vv(2)=pizda(1,2)+pizda(2,1)
7689 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7690 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7691 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7693 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7694 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7695 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7697 C Cartesian gradient
7701 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7703 vv(1)=pizda(1,1)-pizda(2,2)
7704 vv(2)=pizda(1,2)+pizda(2,1)
7705 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7706 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7707 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7713 C Contribution from graph II
7714 call transpose2(EE(1,1,itk),auxmat(1,1))
7715 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7716 vv(1)=pizda(1,1)+pizda(2,2)
7717 vv(2)=pizda(2,1)-pizda(1,2)
7718 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7719 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7720 C Explicit gradient in virtual-dihedral angles.
7721 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7722 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7723 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7724 vv(1)=pizda(1,1)+pizda(2,2)
7725 vv(2)=pizda(2,1)-pizda(1,2)
7727 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7728 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7729 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7731 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7732 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7733 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7735 C Cartesian gradient
7739 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7741 vv(1)=pizda(1,1)+pizda(2,2)
7742 vv(2)=pizda(2,1)-pizda(1,2)
7743 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7744 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7745 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7753 C Parallel orientation
7754 C Contribution from graph III
7755 call transpose2(EUg(1,1,l),auxmat(1,1))
7756 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7757 vv(1)=pizda(1,1)-pizda(2,2)
7758 vv(2)=pizda(1,2)+pizda(2,1)
7759 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7760 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7761 C Explicit gradient in virtual-dihedral angles.
7762 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7763 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7764 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7765 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7766 vv(1)=pizda(1,1)-pizda(2,2)
7767 vv(2)=pizda(1,2)+pizda(2,1)
7768 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7769 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7770 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7771 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7772 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7773 vv(1)=pizda(1,1)-pizda(2,2)
7774 vv(2)=pizda(1,2)+pizda(2,1)
7775 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7776 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7777 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7778 C Cartesian gradient
7782 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7784 vv(1)=pizda(1,1)-pizda(2,2)
7785 vv(2)=pizda(1,2)+pizda(2,1)
7786 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7787 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7788 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7793 C Contribution from graph IV
7795 call transpose2(EE(1,1,itl),auxmat(1,1))
7796 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7797 vv(1)=pizda(1,1)+pizda(2,2)
7798 vv(2)=pizda(2,1)-pizda(1,2)
7799 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7800 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7801 C Explicit gradient in virtual-dihedral angles.
7802 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7803 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7804 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7805 vv(1)=pizda(1,1)+pizda(2,2)
7806 vv(2)=pizda(2,1)-pizda(1,2)
7807 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7808 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7809 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7810 C Cartesian gradient
7814 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7816 vv(1)=pizda(1,1)+pizda(2,2)
7817 vv(2)=pizda(2,1)-pizda(1,2)
7818 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7819 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7820 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7825 C Antiparallel orientation
7826 C Contribution from graph III
7828 call transpose2(EUg(1,1,j),auxmat(1,1))
7829 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7830 vv(1)=pizda(1,1)-pizda(2,2)
7831 vv(2)=pizda(1,2)+pizda(2,1)
7832 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7833 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7834 C Explicit gradient in virtual-dihedral angles.
7835 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7836 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7837 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7838 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7839 vv(1)=pizda(1,1)-pizda(2,2)
7840 vv(2)=pizda(1,2)+pizda(2,1)
7841 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7842 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7843 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7844 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7845 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7846 vv(1)=pizda(1,1)-pizda(2,2)
7847 vv(2)=pizda(1,2)+pizda(2,1)
7848 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7849 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7850 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7851 C Cartesian gradient
7855 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7857 vv(1)=pizda(1,1)-pizda(2,2)
7858 vv(2)=pizda(1,2)+pizda(2,1)
7859 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7860 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7861 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7866 C Contribution from graph IV
7868 call transpose2(EE(1,1,itj),auxmat(1,1))
7869 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7870 vv(1)=pizda(1,1)+pizda(2,2)
7871 vv(2)=pizda(2,1)-pizda(1,2)
7872 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7873 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7874 C Explicit gradient in virtual-dihedral angles.
7875 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7876 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7877 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7878 vv(1)=pizda(1,1)+pizda(2,2)
7879 vv(2)=pizda(2,1)-pizda(1,2)
7880 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7881 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7882 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7883 C Cartesian gradient
7887 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7889 vv(1)=pizda(1,1)+pizda(2,2)
7890 vv(2)=pizda(2,1)-pizda(1,2)
7891 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7892 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7893 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7899 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7900 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7901 cd write (2,*) 'ijkl',i,j,k,l
7902 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7903 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7905 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7906 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7907 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7908 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7909 if (j.lt.nres-1) then
7916 if (l.lt.nres-1) then
7926 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7927 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7928 C summed up outside the subrouine as for the other subroutines
7929 C handling long-range interactions. The old code is commented out
7930 C with "cgrad" to keep track of changes.
7932 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7933 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7934 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7935 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7936 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7937 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7938 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7939 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7940 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7941 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7943 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7944 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7945 cgrad ghalf=0.5d0*ggg1(ll)
7947 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7948 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7949 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7950 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7951 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7952 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7953 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7954 cgrad ghalf=0.5d0*ggg2(ll)
7956 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7957 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7958 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7959 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7960 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7961 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7966 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7967 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7972 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7973 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7979 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7984 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7988 cd write (2,*) iii,g_corr5_loc(iii)
7991 cd write (2,*) 'ekont',ekont
7992 cd write (iout,*) 'eello5',ekont*eel5
7995 c--------------------------------------------------------------------------
7996 double precision function eello6(i,j,k,l,jj,kk)
7997 implicit real*8 (a-h,o-z)
7998 include 'DIMENSIONS'
7999 include 'COMMON.IOUNITS'
8000 include 'COMMON.CHAIN'
8001 include 'COMMON.DERIV'
8002 include 'COMMON.INTERACT'
8003 include 'COMMON.CONTACTS'
8004 include 'COMMON.TORSION'
8005 include 'COMMON.VAR'
8006 include 'COMMON.GEO'
8007 include 'COMMON.FFIELD'
8008 double precision ggg1(3),ggg2(3)
8009 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8014 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8022 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8023 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8027 derx(lll,kkk,iii)=0.0d0
8031 cd eij=facont_hb(jj,i)
8032 cd ekl=facont_hb(kk,k)
8038 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8039 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8040 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8041 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8042 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8043 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8045 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8046 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8047 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8048 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8049 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8050 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8054 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8056 C If turn contributions are considered, they will be handled separately.
8057 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8058 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8059 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8060 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8061 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8062 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8063 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8065 if (j.lt.nres-1) then
8072 if (l.lt.nres-1) then
8080 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8081 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8082 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8083 cgrad ghalf=0.5d0*ggg1(ll)
8085 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8086 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8087 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8088 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8089 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8090 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8091 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8092 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8093 cgrad ghalf=0.5d0*ggg2(ll)
8094 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8096 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8097 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8098 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8099 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8100 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8101 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8106 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8107 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8112 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8113 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8119 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8124 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8128 cd write (2,*) iii,g_corr6_loc(iii)
8131 cd write (2,*) 'ekont',ekont
8132 cd write (iout,*) 'eello6',ekont*eel6
8135 c--------------------------------------------------------------------------
8136 double precision function eello6_graph1(i,j,k,l,imat,swap)
8137 implicit real*8 (a-h,o-z)
8138 include 'DIMENSIONS'
8139 include 'COMMON.IOUNITS'
8140 include 'COMMON.CHAIN'
8141 include 'COMMON.DERIV'
8142 include 'COMMON.INTERACT'
8143 include 'COMMON.CONTACTS'
8144 include 'COMMON.TORSION'
8145 include 'COMMON.VAR'
8146 include 'COMMON.GEO'
8147 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8151 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8153 C Parallel Antiparallel
8159 C \ j|/k\| / \ |/k\|l /
8164 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8165 itk=itortyp(itype(k))
8166 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8167 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8168 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8169 call transpose2(EUgC(1,1,k),auxmat(1,1))
8170 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8171 vv1(1)=pizda1(1,1)-pizda1(2,2)
8172 vv1(2)=pizda1(1,2)+pizda1(2,1)
8173 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8174 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8175 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8176 s5=scalar2(vv(1),Dtobr2(1,i))
8177 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8178 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8179 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8180 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8181 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8182 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8183 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8184 & +scalar2(vv(1),Dtobr2der(1,i)))
8185 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8186 vv1(1)=pizda1(1,1)-pizda1(2,2)
8187 vv1(2)=pizda1(1,2)+pizda1(2,1)
8188 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8189 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8191 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8192 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8193 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8194 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8195 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8197 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8198 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8199 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8200 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8201 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8203 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8204 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8205 vv1(1)=pizda1(1,1)-pizda1(2,2)
8206 vv1(2)=pizda1(1,2)+pizda1(2,1)
8207 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8208 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8209 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8210 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8219 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8220 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8221 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8222 call transpose2(EUgC(1,1,k),auxmat(1,1))
8223 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8225 vv1(1)=pizda1(1,1)-pizda1(2,2)
8226 vv1(2)=pizda1(1,2)+pizda1(2,1)
8227 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8228 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8229 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8230 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8231 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8232 s5=scalar2(vv(1),Dtobr2(1,i))
8233 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8239 c----------------------------------------------------------------------------
8240 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8241 implicit real*8 (a-h,o-z)
8242 include 'DIMENSIONS'
8243 include 'COMMON.IOUNITS'
8244 include 'COMMON.CHAIN'
8245 include 'COMMON.DERIV'
8246 include 'COMMON.INTERACT'
8247 include 'COMMON.CONTACTS'
8248 include 'COMMON.TORSION'
8249 include 'COMMON.VAR'
8250 include 'COMMON.GEO'
8252 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8253 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8256 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8258 C Parallel Antiparallel C
8264 C \ j|/k\| \ |/k\|l C
8269 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8270 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8271 C AL 7/4/01 s1 would occur in the sixth-order moment,
8272 C but not in a cluster cumulant
8274 s1=dip(1,jj,i)*dip(1,kk,k)
8276 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8277 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8278 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8279 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8280 call transpose2(EUg(1,1,k),auxmat(1,1))
8281 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8282 vv(1)=pizda(1,1)-pizda(2,2)
8283 vv(2)=pizda(1,2)+pizda(2,1)
8284 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8285 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8287 eello6_graph2=-(s1+s2+s3+s4)
8289 eello6_graph2=-(s2+s3+s4)
8292 C Derivatives in gamma(i-1)
8295 s1=dipderg(1,jj,i)*dip(1,kk,k)
8297 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8298 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8299 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8300 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8302 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8304 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8306 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8308 C Derivatives in gamma(k-1)
8310 s1=dip(1,jj,i)*dipderg(1,kk,k)
8312 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8313 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8314 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8315 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8316 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8317 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8318 vv(1)=pizda(1,1)-pizda(2,2)
8319 vv(2)=pizda(1,2)+pizda(2,1)
8320 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8322 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8324 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8326 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8327 C Derivatives in gamma(j-1) or gamma(l-1)
8330 s1=dipderg(3,jj,i)*dip(1,kk,k)
8332 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8333 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8334 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8335 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8336 vv(1)=pizda(1,1)-pizda(2,2)
8337 vv(2)=pizda(1,2)+pizda(2,1)
8338 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8341 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8343 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8346 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8347 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8349 C Derivatives in gamma(l-1) or gamma(j-1)
8352 s1=dip(1,jj,i)*dipderg(3,kk,k)
8354 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8355 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8356 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8357 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8358 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8359 vv(1)=pizda(1,1)-pizda(2,2)
8360 vv(2)=pizda(1,2)+pizda(2,1)
8361 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8364 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8366 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8369 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8370 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8372 C Cartesian derivatives.
8374 write (2,*) 'In eello6_graph2'
8376 write (2,*) 'iii=',iii
8378 write (2,*) 'kkk=',kkk
8380 write (2,'(3(2f10.5),5x)')
8381 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8391 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8393 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8396 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8398 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8399 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8401 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8402 call transpose2(EUg(1,1,k),auxmat(1,1))
8403 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8405 vv(1)=pizda(1,1)-pizda(2,2)
8406 vv(2)=pizda(1,2)+pizda(2,1)
8407 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8408 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8410 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8412 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8415 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8417 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8424 c----------------------------------------------------------------------------
8425 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8426 implicit real*8 (a-h,o-z)
8427 include 'DIMENSIONS'
8428 include 'COMMON.IOUNITS'
8429 include 'COMMON.CHAIN'
8430 include 'COMMON.DERIV'
8431 include 'COMMON.INTERACT'
8432 include 'COMMON.CONTACTS'
8433 include 'COMMON.TORSION'
8434 include 'COMMON.VAR'
8435 include 'COMMON.GEO'
8436 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8438 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8440 C Parallel Antiparallel C
8446 C j|/k\| / |/k\|l / C
8451 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8453 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8454 C energy moment and not to the cluster cumulant.
8455 iti=itortyp(itype(i))
8456 if (j.lt.nres-1) then
8457 itj1=itortyp(itype(j+1))
8461 itk=itortyp(itype(k))
8462 itk1=itortyp(itype(k+1))
8463 if (l.lt.nres-1) then
8464 itl1=itortyp(itype(l+1))
8469 s1=dip(4,jj,i)*dip(4,kk,k)
8471 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8472 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8473 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8474 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8475 call transpose2(EE(1,1,itk),auxmat(1,1))
8476 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8477 vv(1)=pizda(1,1)+pizda(2,2)
8478 vv(2)=pizda(2,1)-pizda(1,2)
8479 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8480 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8481 cd & "sum",-(s2+s3+s4)
8483 eello6_graph3=-(s1+s2+s3+s4)
8485 eello6_graph3=-(s2+s3+s4)
8488 C Derivatives in gamma(k-1)
8489 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8490 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8491 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8492 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8493 C Derivatives in gamma(l-1)
8494 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8495 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8496 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8497 vv(1)=pizda(1,1)+pizda(2,2)
8498 vv(2)=pizda(2,1)-pizda(1,2)
8499 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8500 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8501 C Cartesian derivatives.
8507 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8509 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8512 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8514 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8515 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8517 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8518 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8520 vv(1)=pizda(1,1)+pizda(2,2)
8521 vv(2)=pizda(2,1)-pizda(1,2)
8522 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8524 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8526 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8529 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8531 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8533 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8539 c----------------------------------------------------------------------------
8540 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8541 implicit real*8 (a-h,o-z)
8542 include 'DIMENSIONS'
8543 include 'COMMON.IOUNITS'
8544 include 'COMMON.CHAIN'
8545 include 'COMMON.DERIV'
8546 include 'COMMON.INTERACT'
8547 include 'COMMON.CONTACTS'
8548 include 'COMMON.TORSION'
8549 include 'COMMON.VAR'
8550 include 'COMMON.GEO'
8551 include 'COMMON.FFIELD'
8552 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8553 & auxvec1(2),auxmat1(2,2)
8555 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8557 C Parallel Antiparallel C
8563 C \ j|/k\| \ |/k\|l C
8568 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8570 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8571 C energy moment and not to the cluster cumulant.
8572 cd write (2,*) 'eello_graph4: wturn6',wturn6
8573 iti=itortyp(itype(i))
8574 itj=itortyp(itype(j))
8575 if (j.lt.nres-1) then
8576 itj1=itortyp(itype(j+1))
8580 itk=itortyp(itype(k))
8581 if (k.lt.nres-1) then
8582 itk1=itortyp(itype(k+1))
8586 itl=itortyp(itype(l))
8587 if (l.lt.nres-1) then
8588 itl1=itortyp(itype(l+1))
8592 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8593 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8594 cd & ' itl',itl,' itl1',itl1
8597 s1=dip(3,jj,i)*dip(3,kk,k)
8599 s1=dip(2,jj,j)*dip(2,kk,l)
8602 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8603 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8605 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8606 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8608 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8609 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8611 call transpose2(EUg(1,1,k),auxmat(1,1))
8612 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8613 vv(1)=pizda(1,1)-pizda(2,2)
8614 vv(2)=pizda(2,1)+pizda(1,2)
8615 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8616 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8618 eello6_graph4=-(s1+s2+s3+s4)
8620 eello6_graph4=-(s2+s3+s4)
8622 C Derivatives in gamma(i-1)
8626 s1=dipderg(2,jj,i)*dip(3,kk,k)
8628 s1=dipderg(4,jj,j)*dip(2,kk,l)
8631 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8633 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8634 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8636 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8637 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8639 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8640 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8641 cd write (2,*) 'turn6 derivatives'
8643 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8645 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8649 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8651 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8655 C Derivatives in gamma(k-1)
8658 s1=dip(3,jj,i)*dipderg(2,kk,k)
8660 s1=dip(2,jj,j)*dipderg(4,kk,l)
8663 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8664 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8666 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8667 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8669 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8670 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8672 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8673 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8674 vv(1)=pizda(1,1)-pizda(2,2)
8675 vv(2)=pizda(2,1)+pizda(1,2)
8676 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8677 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8679 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8681 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8685 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8687 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8690 C Derivatives in gamma(j-1) or gamma(l-1)
8691 if (l.eq.j+1 .and. l.gt.1) then
8692 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8693 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8694 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8695 vv(1)=pizda(1,1)-pizda(2,2)
8696 vv(2)=pizda(2,1)+pizda(1,2)
8697 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8698 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8699 else if (j.gt.1) then
8700 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8701 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8702 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8703 vv(1)=pizda(1,1)-pizda(2,2)
8704 vv(2)=pizda(2,1)+pizda(1,2)
8705 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8706 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8707 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8709 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8712 C Cartesian derivatives.
8719 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8721 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8725 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8727 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8731 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8733 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8735 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8736 & b1(1,itj1),auxvec(1))
8737 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8739 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8740 & b1(1,itl1),auxvec(1))
8741 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8743 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8745 vv(1)=pizda(1,1)-pizda(2,2)
8746 vv(2)=pizda(2,1)+pizda(1,2)
8747 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8749 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8751 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8754 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8757 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8760 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8762 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8764 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8768 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8770 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8773 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8775 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8783 c----------------------------------------------------------------------------
8784 double precision function eello_turn6(i,jj,kk)
8785 implicit real*8 (a-h,o-z)
8786 include 'DIMENSIONS'
8787 include 'COMMON.IOUNITS'
8788 include 'COMMON.CHAIN'
8789 include 'COMMON.DERIV'
8790 include 'COMMON.INTERACT'
8791 include 'COMMON.CONTACTS'
8792 include 'COMMON.TORSION'
8793 include 'COMMON.VAR'
8794 include 'COMMON.GEO'
8795 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8796 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8798 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8799 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8800 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8801 C the respective energy moment and not to the cluster cumulant.
8810 iti=itortyp(itype(i))
8811 itk=itortyp(itype(k))
8812 itk1=itortyp(itype(k+1))
8813 itl=itortyp(itype(l))
8814 itj=itortyp(itype(j))
8815 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8816 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8817 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8822 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8824 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8828 derx_turn(lll,kkk,iii)=0.0d0
8835 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8837 cd write (2,*) 'eello6_5',eello6_5
8839 call transpose2(AEA(1,1,1),auxmat(1,1))
8840 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8841 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8842 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8844 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8845 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8846 s2 = scalar2(b1(1,itk),vtemp1(1))
8848 call transpose2(AEA(1,1,2),atemp(1,1))
8849 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8850 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8851 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8853 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8854 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8855 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8857 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8858 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8859 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8860 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8861 ss13 = scalar2(b1(1,itk),vtemp4(1))
8862 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8864 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8870 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8871 C Derivatives in gamma(i+2)
8875 call transpose2(AEA(1,1,1),auxmatd(1,1))
8876 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8877 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8878 call transpose2(AEAderg(1,1,2),atempd(1,1))
8879 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8880 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8882 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8883 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8884 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8890 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8891 C Derivatives in gamma(i+3)
8893 call transpose2(AEA(1,1,1),auxmatd(1,1))
8894 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8895 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8896 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8898 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8899 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8900 s2d = scalar2(b1(1,itk),vtemp1d(1))
8902 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8903 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8905 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8907 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8908 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8909 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8917 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8918 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8920 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8921 & -0.5d0*ekont*(s2d+s12d)
8923 C Derivatives in gamma(i+4)
8924 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8925 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8926 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8928 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8929 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8930 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8938 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8940 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8942 C Derivatives in gamma(i+5)
8944 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8945 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8946 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8948 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8949 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8950 s2d = scalar2(b1(1,itk),vtemp1d(1))
8952 call transpose2(AEA(1,1,2),atempd(1,1))
8953 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8954 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8956 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8957 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8959 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8960 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8961 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8969 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8970 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8972 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8973 & -0.5d0*ekont*(s2d+s12d)
8975 C Cartesian derivatives
8980 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8981 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8982 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8984 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8985 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8987 s2d = scalar2(b1(1,itk),vtemp1d(1))
8989 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8990 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8991 s8d = -(atempd(1,1)+atempd(2,2))*
8992 & scalar2(cc(1,1,itl),vtemp2(1))
8994 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8996 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8997 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9004 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9007 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9011 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9012 & - 0.5d0*(s8d+s12d)
9014 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9023 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9025 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9026 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9027 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9028 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9029 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9031 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9032 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9033 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9037 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9038 cd & 16*eel_turn6_num
9040 if (j.lt.nres-1) then
9047 if (l.lt.nres-1) then
9055 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9056 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9057 cgrad ghalf=0.5d0*ggg1(ll)
9059 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9060 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9061 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9062 & +ekont*derx_turn(ll,2,1)
9063 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9064 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9065 & +ekont*derx_turn(ll,4,1)
9066 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9067 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9068 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9069 cgrad ghalf=0.5d0*ggg2(ll)
9071 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9072 & +ekont*derx_turn(ll,2,2)
9073 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9074 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9075 & +ekont*derx_turn(ll,4,2)
9076 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9077 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9078 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9083 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9088 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9094 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9099 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9103 cd write (2,*) iii,g_corr6_loc(iii)
9105 eello_turn6=ekont*eel_turn6
9106 cd write (2,*) 'ekont',ekont
9107 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9111 C-----------------------------------------------------------------------------
9112 double precision function scalar(u,v)
9113 !DIR$ INLINEALWAYS scalar
9115 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9118 double precision u(3),v(3)
9119 cd double precision sc
9127 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9130 crc-------------------------------------------------
9131 SUBROUTINE MATVEC2(A1,V1,V2)
9132 !DIR$ INLINEALWAYS MATVEC2
9134 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9136 implicit real*8 (a-h,o-z)
9137 include 'DIMENSIONS'
9138 DIMENSION A1(2,2),V1(2),V2(2)
9142 c 3 VI=VI+A1(I,K)*V1(K)
9146 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9147 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9152 C---------------------------------------
9153 SUBROUTINE MATMAT2(A1,A2,A3)
9155 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9157 implicit real*8 (a-h,o-z)
9158 include 'DIMENSIONS'
9159 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9160 c DIMENSION AI3(2,2)
9164 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9170 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9171 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9172 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9173 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9181 c-------------------------------------------------------------------------
9182 double precision function scalar2(u,v)
9183 !DIR$ INLINEALWAYS scalar2
9185 double precision u(2),v(2)
9188 scalar2=u(1)*v(1)+u(2)*v(2)
9192 C-----------------------------------------------------------------------------
9194 subroutine transpose2(a,at)
9195 !DIR$ INLINEALWAYS transpose2
9197 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9200 double precision a(2,2),at(2,2)
9207 c--------------------------------------------------------------------------
9208 subroutine transpose(n,a,at)
9211 double precision a(n,n),at(n,n)
9219 C---------------------------------------------------------------------------
9220 subroutine prodmat3(a1,a2,kk,transp,prod)
9221 !DIR$ INLINEALWAYS prodmat3
9223 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9227 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9229 crc double precision auxmat(2,2),prod_(2,2)
9232 crc call transpose2(kk(1,1),auxmat(1,1))
9233 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9234 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9236 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9237 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9238 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9239 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9240 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9241 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9242 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9243 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9246 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9247 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9249 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9250 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9251 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9252 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9253 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9254 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9255 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9256 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9259 c call transpose2(a2(1,1),a2t(1,1))
9262 crc print *,((prod_(i,j),i=1,2),j=1,2)
9263 crc print *,((prod(i,j),i=1,2),j=1,2)