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 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 c print *," Processor",myrank," left SUM_ENERGY"
337 time_sumene=time_sumene+MPI_Wtime()-time00
339 time_sumene=time_sumene+tcpu()-time00
344 c-------------------------------------------------------------------------------
345 subroutine sum_energy(energia,reduce)
346 implicit real*8 (a-h,o-z)
351 cMS$ATTRIBUTES C :: proc_proc
357 include 'COMMON.SETUP'
358 include 'COMMON.IOUNITS'
359 double precision energia(0:n_ene),enebuff(0:n_ene+1)
360 include 'COMMON.FFIELD'
361 include 'COMMON.DERIV'
362 include 'COMMON.INTERACT'
363 include 'COMMON.SBRIDGE'
364 include 'COMMON.CHAIN'
366 include 'COMMON.CONTROL'
367 include 'COMMON.TIME1'
370 if (nfgtasks.gt.1 .and. reduce) then
372 write (iout,*) "energies before REDUCE"
373 call enerprint(energia)
377 enebuff(i)=energia(i)
380 call MPI_Barrier(FG_COMM,IERR)
381 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
383 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
384 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
386 write (iout,*) "energies after REDUCE"
387 call enerprint(energia)
390 time_Reduce=time_Reduce+MPI_Wtime()-time00
392 if (fg_rank.eq.0) then
395 evdw=energia(22)+wsct*energia(23)
400 evdw2=energia(2)+energia(18)
416 eello_turn3=energia(8)
417 eello_turn4=energia(9)
424 edihcnstr=energia(19)
429 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
430 & +wang*ebe+wtor*etors+wscloc*escloc
431 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
432 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
433 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
434 & +wbond*estr+Uconst+wsccor*esccor
436 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
437 & +wang*ebe+wtor*etors+wscloc*escloc
438 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
439 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
440 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
441 & +wbond*estr+Uconst+wsccor*esccor
447 if (isnan(etot).ne.0) energia(0)=1.0d+99
449 if (isnan(etot)) energia(0)=1.0d+99
454 idumm=proc_proc(etot,i)
456 call proc_proc(etot,i)
458 if(i.eq.1)energia(0)=1.0d+99
465 c-------------------------------------------------------------------------------
466 subroutine sum_gradient
467 implicit real*8 (a-h,o-z)
472 cMS$ATTRIBUTES C :: proc_proc
478 double precision gradbufc(3,maxres),gradbufx(3,maxres),
479 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
480 include 'COMMON.SETUP'
481 include 'COMMON.IOUNITS'
482 include 'COMMON.FFIELD'
483 include 'COMMON.DERIV'
484 include 'COMMON.INTERACT'
485 include 'COMMON.SBRIDGE'
486 include 'COMMON.CHAIN'
488 include 'COMMON.CONTROL'
489 include 'COMMON.TIME1'
490 include 'COMMON.MAXGRAD'
491 include 'COMMON.SCCOR'
500 write (iout,*) "sum_gradient gvdwc, gvdwx"
502 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
503 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
504 & (gvdwcT(j,i),j=1,3)
509 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
510 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
511 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
514 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
515 C in virtual-bond-vector coordinates
518 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
520 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
521 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
523 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
525 c write (iout,'(i5,3f10.5,2x,f10.5)')
526 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
528 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
530 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
531 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
540 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
541 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
542 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
543 & wel_loc*gel_loc_long(j,i)+
544 & wcorr*gradcorr_long(j,i)+
545 & wcorr5*gradcorr5_long(j,i)+
546 & wcorr6*gradcorr6_long(j,i)+
547 & wturn6*gcorr6_turn_long(j,i)+
554 gradbufc(j,i)=wsc*gvdwc(j,i)+
555 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
556 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
557 & wel_loc*gel_loc_long(j,i)+
558 & wcorr*gradcorr_long(j,i)+
559 & wcorr5*gradcorr5_long(j,i)+
560 & wcorr6*gradcorr6_long(j,i)+
561 & wturn6*gcorr6_turn_long(j,i)+
569 gradbufc(j,i)=wsc*gvdwc(j,i)+
570 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
571 & welec*gelc_long(j,i)+
573 & wel_loc*gel_loc_long(j,i)+
574 & wcorr*gradcorr_long(j,i)+
575 & wcorr5*gradcorr5_long(j,i)+
576 & wcorr6*gradcorr6_long(j,i)+
577 & wturn6*gcorr6_turn_long(j,i)+
583 if (nfgtasks.gt.1) then
586 write (iout,*) "gradbufc before allreduce"
588 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
594 gradbufc_sum(j,i)=gradbufc(j,i)
597 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
598 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
599 c time_reduce=time_reduce+MPI_Wtime()-time00
601 c write (iout,*) "gradbufc_sum after allreduce"
603 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
608 c time_allreduce=time_allreduce+MPI_Wtime()-time00
616 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
617 write (iout,*) (i," jgrad_start",jgrad_start(i),
618 & " jgrad_end ",jgrad_end(i),
619 & i=igrad_start,igrad_end)
622 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
623 c do not parallelize this part.
625 c do i=igrad_start,igrad_end
626 c do j=jgrad_start(i),jgrad_end(i)
628 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
633 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
637 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
641 write (iout,*) "gradbufc after summing"
643 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
650 write (iout,*) "gradbufc"
652 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
658 gradbufc_sum(j,i)=gradbufc(j,i)
663 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
667 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
672 c gradbufc(k,i)=0.0d0
676 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
681 write (iout,*) "gradbufc after summing"
683 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
691 gradbufc(k,nres)=0.0d0
696 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
697 & wel_loc*gel_loc(j,i)+
698 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
699 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
700 & wel_loc*gel_loc_long(j,i)+
701 & wcorr*gradcorr_long(j,i)+
702 & wcorr5*gradcorr5_long(j,i)+
703 & wcorr6*gradcorr6_long(j,i)+
704 & wturn6*gcorr6_turn_long(j,i))+
706 & wcorr*gradcorr(j,i)+
707 & wturn3*gcorr3_turn(j,i)+
708 & wturn4*gcorr4_turn(j,i)+
709 & wcorr5*gradcorr5(j,i)+
710 & wcorr6*gradcorr6(j,i)+
711 & wturn6*gcorr6_turn(j,i)+
712 & wsccor*gsccorc(j,i)
713 & +wscloc*gscloc(j,i)
715 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
716 & wel_loc*gel_loc(j,i)+
717 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
718 & welec*gelc_long(j,i)+
719 & wel_loc*gel_loc_long(j,i)+
720 & wcorr*gcorr_long(j,i)+
721 & wcorr5*gradcorr5_long(j,i)+
722 & wcorr6*gradcorr6_long(j,i)+
723 & wturn6*gcorr6_turn_long(j,i))+
725 & wcorr*gradcorr(j,i)+
726 & wturn3*gcorr3_turn(j,i)+
727 & wturn4*gcorr4_turn(j,i)+
728 & wcorr5*gradcorr5(j,i)+
729 & wcorr6*gradcorr6(j,i)+
730 & wturn6*gcorr6_turn(j,i)+
731 & wsccor*gsccorc(j,i)
732 & +wscloc*gscloc(j,i)
735 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
736 & wscp*gradx_scp(j,i)+
738 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
739 & wsccor*gsccorx(j,i)
740 & +wscloc*gsclocx(j,i)
742 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
744 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
745 & wsccor*gsccorx(j,i)
746 & +wscloc*gsclocx(j,i)
751 write (iout,*) "gloc before adding corr"
753 write (iout,*) i,gloc(i,icg)
757 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
758 & +wcorr5*g_corr5_loc(i)
759 & +wcorr6*g_corr6_loc(i)
760 & +wturn4*gel_loc_turn4(i)
761 & +wturn3*gel_loc_turn3(i)
762 & +wturn6*gel_loc_turn6(i)
763 & +wel_loc*gel_loc_loc(i)
766 write (iout,*) "gloc after adding corr"
768 write (iout,*) i,gloc(i,icg)
772 if (nfgtasks.gt.1) then
775 gradbufc(j,i)=gradc(j,i,icg)
776 gradbufx(j,i)=gradx(j,i,icg)
780 glocbuf(i)=gloc(i,icg)
783 write (iout,*) "gloc_sc before reduce"
786 write (iout,*) i,j,gloc_sc(j,i,icg)
792 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
796 call MPI_Barrier(FG_COMM,IERR)
797 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
799 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
800 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
801 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
802 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
803 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
804 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
805 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
806 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
807 time_reduce=time_reduce+MPI_Wtime()-time00
809 write (iout,*) "gloc_sc after reduce"
812 write (iout,*) i,j,gloc_sc(j,i,icg)
817 write (iout,*) "gloc after reduce"
819 write (iout,*) i,gloc(i,icg)
824 if (gnorm_check) then
826 c Compute the maximum elements of the gradient
836 gcorr3_turn_max=0.0d0
837 gcorr4_turn_max=0.0d0
840 gcorr6_turn_max=0.0d0
850 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
851 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
853 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
854 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
856 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
857 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
858 & gvdwc_scp_max=gvdwc_scp_norm
859 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
860 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
861 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
862 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
863 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
864 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
865 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
866 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
867 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
868 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
869 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
870 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
871 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
873 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
874 & gcorr3_turn_max=gcorr3_turn_norm
875 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
877 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
878 & gcorr4_turn_max=gcorr4_turn_norm
879 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
880 if (gradcorr5_norm.gt.gradcorr5_max)
881 & gradcorr5_max=gradcorr5_norm
882 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
883 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
884 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
886 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
887 & gcorr6_turn_max=gcorr6_turn_norm
888 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
889 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
890 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
891 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
892 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
893 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
895 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
896 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
898 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
899 if (gradx_scp_norm.gt.gradx_scp_max)
900 & gradx_scp_max=gradx_scp_norm
901 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
902 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
903 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
904 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
905 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
906 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
907 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
908 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
912 open(istat,file=statname,position="append")
914 open(istat,file=statname,access="append")
916 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
917 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
918 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
919 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
920 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
921 & gsccorx_max,gsclocx_max
923 if (gvdwc_max.gt.1.0d4) then
924 write (iout,*) "gvdwc gvdwx gradb gradbx"
926 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
927 & gradb(j,i),gradbx(j,i),j=1,3)
929 call pdbout(0.0d0,'cipiszcze',iout)
935 write (iout,*) "gradc gradx gloc"
937 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
938 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
943 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
945 time_sumgradient=time_sumgradient+tcpu()-time01
950 c-------------------------------------------------------------------------------
951 subroutine rescale_weights(t_bath)
952 implicit real*8 (a-h,o-z)
954 include 'COMMON.IOUNITS'
955 include 'COMMON.FFIELD'
956 include 'COMMON.SBRIDGE'
957 double precision kfac /2.4d0/
958 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
960 c facT=2*temp0/(t_bath+temp0)
961 if (rescale_mode.eq.0) then
967 else if (rescale_mode.eq.1) then
968 facT=kfac/(kfac-1.0d0+t_bath/temp0)
969 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
970 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
971 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
972 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
973 else if (rescale_mode.eq.2) then
979 facT=licznik/dlog(dexp(x)+dexp(-x))
980 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
981 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
982 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
983 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
985 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
986 write (*,*) "Wrong RESCALE_MODE",rescale_mode
988 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
992 welec=weights(3)*fact
993 wcorr=weights(4)*fact3
994 wcorr5=weights(5)*fact4
995 wcorr6=weights(6)*fact5
996 wel_loc=weights(7)*fact2
997 wturn3=weights(8)*fact2
998 wturn4=weights(9)*fact3
999 wturn6=weights(10)*fact5
1000 wtor=weights(13)*fact
1001 wtor_d=weights(14)*fact2
1002 wsccor=weights(21)*fact
1005 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1009 C------------------------------------------------------------------------
1010 subroutine enerprint(energia)
1011 implicit real*8 (a-h,o-z)
1012 include 'DIMENSIONS'
1013 include 'COMMON.IOUNITS'
1014 include 'COMMON.FFIELD'
1015 include 'COMMON.SBRIDGE'
1017 double precision energia(0:n_ene)
1020 evdw=energia(22)+wsct*energia(23)
1026 evdw2=energia(2)+energia(18)
1038 eello_turn3=energia(8)
1039 eello_turn4=energia(9)
1040 eello_turn6=energia(10)
1046 edihcnstr=energia(19)
1051 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1052 & estr,wbond,ebe,wang,
1053 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1055 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1056 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1057 & edihcnstr,ebr*nss,
1059 10 format (/'Virtual-chain energies:'//
1060 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1061 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1062 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1063 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1064 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1065 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1066 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1067 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1068 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1069 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1070 & ' (SS bridges & dist. cnstr.)'/
1071 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1072 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1073 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1074 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1075 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1076 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1077 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1078 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1079 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1080 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1081 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1082 & 'ETOT= ',1pE16.6,' (total)')
1084 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1085 & estr,wbond,ebe,wang,
1086 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1088 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1089 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1090 & ebr*nss,Uconst,etot
1091 10 format (/'Virtual-chain energies:'//
1092 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1093 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1094 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1095 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1096 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1097 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1098 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1099 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1100 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1101 & ' (SS bridges & dist. cnstr.)'/
1102 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1103 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1104 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1105 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1106 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1107 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1108 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1109 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1110 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1111 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1112 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1113 & 'ETOT= ',1pE16.6,' (total)')
1117 C-----------------------------------------------------------------------
1118 subroutine elj(evdw,evdw_p,evdw_m)
1120 C This subroutine calculates the interaction energy of nonbonded side chains
1121 C assuming the LJ potential of interaction.
1123 implicit real*8 (a-h,o-z)
1124 include 'DIMENSIONS'
1125 parameter (accur=1.0d-10)
1126 include 'COMMON.GEO'
1127 include 'COMMON.VAR'
1128 include 'COMMON.LOCAL'
1129 include 'COMMON.CHAIN'
1130 include 'COMMON.DERIV'
1131 include 'COMMON.INTERACT'
1132 include 'COMMON.TORSION'
1133 include 'COMMON.SBRIDGE'
1134 include 'COMMON.NAMES'
1135 include 'COMMON.IOUNITS'
1136 include 'COMMON.CONTACTS'
1138 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1140 do i=iatsc_s,iatsc_e
1149 C Calculate SC interaction energy.
1151 do iint=1,nint_gr(i)
1152 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1153 cd & 'iend=',iend(i,iint)
1154 do j=istart(i,iint),iend(i,iint)
1159 C Change 12/1/95 to calculate four-body interactions
1160 rij=xj*xj+yj*yj+zj*zj
1162 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1163 eps0ij=eps(itypi,itypj)
1165 e1=fac*fac*aa(itypi,itypj)
1166 e2=fac*bb(itypi,itypj)
1168 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1169 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1170 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1171 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1172 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1173 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1175 if (bb(itypi,itypj).gt.0) then
1176 evdw_p=evdw_p+evdwij
1178 evdw_m=evdw_m+evdwij
1184 C Calculate the components of the gradient in DC and X
1186 fac=-rrij*(e1+evdwij)
1191 if (bb(itypi,itypj).gt.0.0d0) then
1193 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1194 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1195 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1196 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1200 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1201 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1202 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1203 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1208 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1209 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1210 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1211 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1216 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1220 C 12/1/95, revised on 5/20/97
1222 C Calculate the contact function. The ith column of the array JCONT will
1223 C contain the numbers of atoms that make contacts with the atom I (of numbers
1224 C greater than I). The arrays FACONT and GACONT will contain the values of
1225 C the contact function and its derivative.
1227 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1228 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1229 C Uncomment next line, if the correlation interactions are contact function only
1230 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1232 sigij=sigma(itypi,itypj)
1233 r0ij=rs0(itypi,itypj)
1235 C Check whether the SC's are not too far to make a contact.
1238 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1239 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1241 if (fcont.gt.0.0D0) then
1242 C If the SC-SC distance if close to sigma, apply spline.
1243 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1244 cAdam & fcont1,fprimcont1)
1245 cAdam fcont1=1.0d0-fcont1
1246 cAdam if (fcont1.gt.0.0d0) then
1247 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1248 cAdam fcont=fcont*fcont1
1250 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1251 cga eps0ij=1.0d0/dsqrt(eps0ij)
1253 cga gg(k)=gg(k)*eps0ij
1255 cga eps0ij=-evdwij*eps0ij
1256 C Uncomment for AL's type of SC correlation interactions.
1257 cadam eps0ij=-evdwij
1258 num_conti=num_conti+1
1259 jcont(num_conti,i)=j
1260 facont(num_conti,i)=fcont*eps0ij
1261 fprimcont=eps0ij*fprimcont/rij
1263 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1264 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1265 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1266 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1267 gacont(1,num_conti,i)=-fprimcont*xj
1268 gacont(2,num_conti,i)=-fprimcont*yj
1269 gacont(3,num_conti,i)=-fprimcont*zj
1270 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1271 cd write (iout,'(2i3,3f10.5)')
1272 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1278 num_cont(i)=num_conti
1282 gvdwc(j,i)=expon*gvdwc(j,i)
1283 gvdwx(j,i)=expon*gvdwx(j,i)
1286 C******************************************************************************
1290 C To save time, the factor of EXPON has been extracted from ALL components
1291 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1294 C******************************************************************************
1297 C-----------------------------------------------------------------------------
1298 subroutine eljk(evdw,evdw_p,evdw_m)
1300 C This subroutine calculates the interaction energy of nonbonded side chains
1301 C assuming the LJK potential of interaction.
1303 implicit real*8 (a-h,o-z)
1304 include 'DIMENSIONS'
1305 include 'COMMON.GEO'
1306 include 'COMMON.VAR'
1307 include 'COMMON.LOCAL'
1308 include 'COMMON.CHAIN'
1309 include 'COMMON.DERIV'
1310 include 'COMMON.INTERACT'
1311 include 'COMMON.IOUNITS'
1312 include 'COMMON.NAMES'
1315 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1317 do i=iatsc_s,iatsc_e
1324 C Calculate SC interaction energy.
1326 do iint=1,nint_gr(i)
1327 do j=istart(i,iint),iend(i,iint)
1332 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1333 fac_augm=rrij**expon
1334 e_augm=augm(itypi,itypj)*fac_augm
1335 r_inv_ij=dsqrt(rrij)
1337 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1338 fac=r_shift_inv**expon
1339 e1=fac*fac*aa(itypi,itypj)
1340 e2=fac*bb(itypi,itypj)
1342 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1343 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1344 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1345 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1346 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1347 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1348 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1350 if (bb(itypi,itypj).gt.0) then
1351 evdw_p=evdw_p+evdwij
1353 evdw_m=evdw_m+evdwij
1359 C Calculate the components of the gradient in DC and X
1361 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1366 if (bb(itypi,itypj).gt.0.0d0) then
1368 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1369 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1370 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1371 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1375 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1376 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1377 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1378 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1383 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1384 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1385 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1386 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1391 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1399 gvdwc(j,i)=expon*gvdwc(j,i)
1400 gvdwx(j,i)=expon*gvdwx(j,i)
1405 C-----------------------------------------------------------------------------
1406 subroutine ebp(evdw,evdw_p,evdw_m)
1408 C This subroutine calculates the interaction energy of nonbonded side chains
1409 C assuming the Berne-Pechukas potential of interaction.
1411 implicit real*8 (a-h,o-z)
1412 include 'DIMENSIONS'
1413 include 'COMMON.GEO'
1414 include 'COMMON.VAR'
1415 include 'COMMON.LOCAL'
1416 include 'COMMON.CHAIN'
1417 include 'COMMON.DERIV'
1418 include 'COMMON.NAMES'
1419 include 'COMMON.INTERACT'
1420 include 'COMMON.IOUNITS'
1421 include 'COMMON.CALC'
1422 common /srutu/ icall
1423 c double precision rrsave(maxdim)
1426 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1428 c if (icall.eq.0) then
1434 do i=iatsc_s,iatsc_e
1440 dxi=dc_norm(1,nres+i)
1441 dyi=dc_norm(2,nres+i)
1442 dzi=dc_norm(3,nres+i)
1443 c dsci_inv=dsc_inv(itypi)
1444 dsci_inv=vbld_inv(i+nres)
1446 C Calculate SC interaction energy.
1448 do iint=1,nint_gr(i)
1449 do j=istart(i,iint),iend(i,iint)
1452 c dscj_inv=dsc_inv(itypj)
1453 dscj_inv=vbld_inv(j+nres)
1454 chi1=chi(itypi,itypj)
1455 chi2=chi(itypj,itypi)
1462 alf12=0.5D0*(alf1+alf2)
1463 C For diagnostics only!!!
1476 dxj=dc_norm(1,nres+j)
1477 dyj=dc_norm(2,nres+j)
1478 dzj=dc_norm(3,nres+j)
1479 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1480 cd if (icall.eq.0) then
1486 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1488 C Calculate whole angle-dependent part of epsilon and contributions
1489 C to its derivatives
1490 fac=(rrij*sigsq)**expon2
1491 e1=fac*fac*aa(itypi,itypj)
1492 e2=fac*bb(itypi,itypj)
1493 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1494 eps2der=evdwij*eps3rt
1495 eps3der=evdwij*eps2rt
1496 evdwij=evdwij*eps2rt*eps3rt
1498 if (bb(itypi,itypj).gt.0) then
1499 evdw_p=evdw_p+evdwij
1501 evdw_m=evdw_m+evdwij
1507 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1508 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1509 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1510 cd & restyp(itypi),i,restyp(itypj),j,
1511 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1512 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1513 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1516 C Calculate gradient components.
1517 e1=e1*eps1*eps2rt**2*eps3rt**2
1518 fac=-expon*(e1+evdwij)
1521 C Calculate radial part of the gradient
1525 C Calculate the angular part of the gradient and sum add the contributions
1526 C to the appropriate components of the Cartesian gradient.
1528 if (bb(itypi,itypj).gt.0) then
1542 C-----------------------------------------------------------------------------
1543 subroutine egb(evdw,evdw_p,evdw_m)
1545 C This subroutine calculates the interaction energy of nonbonded side chains
1546 C assuming the Gay-Berne potential of interaction.
1548 implicit real*8 (a-h,o-z)
1549 include 'DIMENSIONS'
1550 include 'COMMON.GEO'
1551 include 'COMMON.VAR'
1552 include 'COMMON.LOCAL'
1553 include 'COMMON.CHAIN'
1554 include 'COMMON.DERIV'
1555 include 'COMMON.NAMES'
1556 include 'COMMON.INTERACT'
1557 include 'COMMON.IOUNITS'
1558 include 'COMMON.CALC'
1559 include 'COMMON.CONTROL'
1560 include 'COMMON.SBRIDGE'
1563 ccccc energy_dec=.false.
1564 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1569 c if (icall.eq.0) lprn=.false.
1571 do i=iatsc_s,iatsc_e
1577 dxi=dc_norm(1,nres+i)
1578 dyi=dc_norm(2,nres+i)
1579 dzi=dc_norm(3,nres+i)
1580 c dsci_inv=dsc_inv(itypi)
1581 dsci_inv=vbld_inv(i+nres)
1582 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1583 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1585 C Calculate SC interaction energy.
1587 do iint=1,nint_gr(i)
1588 do j=istart(i,iint),iend(i,iint)
1589 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1590 call dyn_ssbond_ene(i,j,evdwij)
1592 cdebug write(iout,*) 'dyn_ssbond_ene ',evdwij
1596 c dscj_inv=dsc_inv(itypj)
1597 dscj_inv=vbld_inv(j+nres)
1598 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1599 c & 1.0d0/vbld(j+nres)
1600 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1601 sig0ij=sigma(itypi,itypj)
1602 chi1=chi(itypi,itypj)
1603 chi2=chi(itypj,itypi)
1610 alf12=0.5D0*(alf1+alf2)
1611 C For diagnostics only!!!
1624 dxj=dc_norm(1,nres+j)
1625 dyj=dc_norm(2,nres+j)
1626 dzj=dc_norm(3,nres+j)
1627 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1628 c write (iout,*) "j",j," dc_norm",
1629 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1630 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1632 C Calculate angle-dependent terms of energy and contributions to their
1636 sig=sig0ij*dsqrt(sigsq)
1637 rij_shift=1.0D0/rij-sig+sig0ij
1638 c for diagnostics; uncomment
1639 c rij_shift=1.2*sig0ij
1640 C I hate to put IF's in the loops, but here don't have another choice!!!!
1641 if (rij_shift.le.0.0D0) then
1643 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1644 cd & restyp(itypi),i,restyp(itypj),j,
1645 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1649 c---------------------------------------------------------------
1650 rij_shift=1.0D0/rij_shift
1651 fac=rij_shift**expon
1652 e1=fac*fac*aa(itypi,itypj)
1653 e2=fac*bb(itypi,itypj)
1654 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1655 eps2der=evdwij*eps3rt
1656 eps3der=evdwij*eps2rt
1657 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1658 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1659 evdwij=evdwij*eps2rt*eps3rt
1661 if (bb(itypi,itypj).gt.0) then
1662 evdw_p=evdw_p+evdwij
1664 evdw_m=evdw_m+evdwij
1670 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1671 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1672 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1673 & restyp(itypi),i,restyp(itypj),j,
1674 & epsi,sigm,chi1,chi2,chip1,chip2,
1675 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1676 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1680 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1683 C Calculate gradient components.
1684 e1=e1*eps1*eps2rt**2*eps3rt**2
1685 fac=-expon*(e1+evdwij)*rij_shift
1689 C Calculate the radial part of the gradient
1693 C Calculate angular part of the gradient.
1695 if (bb(itypi,itypj).gt.0) then
1707 c write (iout,*) "Number of loop steps in EGB:",ind
1708 cccc energy_dec=.false.
1711 C-----------------------------------------------------------------------------
1712 subroutine egbv(evdw,evdw_p,evdw_m)
1714 C This subroutine calculates the interaction energy of nonbonded side chains
1715 C assuming the Gay-Berne-Vorobjev potential of interaction.
1717 implicit real*8 (a-h,o-z)
1718 include 'DIMENSIONS'
1719 include 'COMMON.GEO'
1720 include 'COMMON.VAR'
1721 include 'COMMON.LOCAL'
1722 include 'COMMON.CHAIN'
1723 include 'COMMON.DERIV'
1724 include 'COMMON.NAMES'
1725 include 'COMMON.INTERACT'
1726 include 'COMMON.IOUNITS'
1727 include 'COMMON.CALC'
1728 common /srutu/ icall
1731 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1734 c if (icall.eq.0) lprn=.true.
1736 do i=iatsc_s,iatsc_e
1742 dxi=dc_norm(1,nres+i)
1743 dyi=dc_norm(2,nres+i)
1744 dzi=dc_norm(3,nres+i)
1745 c dsci_inv=dsc_inv(itypi)
1746 dsci_inv=vbld_inv(i+nres)
1748 C Calculate SC interaction energy.
1750 do iint=1,nint_gr(i)
1751 do j=istart(i,iint),iend(i,iint)
1754 c dscj_inv=dsc_inv(itypj)
1755 dscj_inv=vbld_inv(j+nres)
1756 sig0ij=sigma(itypi,itypj)
1757 r0ij=r0(itypi,itypj)
1758 chi1=chi(itypi,itypj)
1759 chi2=chi(itypj,itypi)
1766 alf12=0.5D0*(alf1+alf2)
1767 C For diagnostics only!!!
1780 dxj=dc_norm(1,nres+j)
1781 dyj=dc_norm(2,nres+j)
1782 dzj=dc_norm(3,nres+j)
1783 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1785 C Calculate angle-dependent terms of energy and contributions to their
1789 sig=sig0ij*dsqrt(sigsq)
1790 rij_shift=1.0D0/rij-sig+r0ij
1791 C I hate to put IF's in the loops, but here don't have another choice!!!!
1792 if (rij_shift.le.0.0D0) then
1797 c---------------------------------------------------------------
1798 rij_shift=1.0D0/rij_shift
1799 fac=rij_shift**expon
1800 e1=fac*fac*aa(itypi,itypj)
1801 e2=fac*bb(itypi,itypj)
1802 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1803 eps2der=evdwij*eps3rt
1804 eps3der=evdwij*eps2rt
1805 fac_augm=rrij**expon
1806 e_augm=augm(itypi,itypj)*fac_augm
1807 evdwij=evdwij*eps2rt*eps3rt
1809 if (bb(itypi,itypj).gt.0) then
1810 evdw_p=evdw_p+evdwij+e_augm
1812 evdw_m=evdw_m+evdwij+e_augm
1815 evdw=evdw+evdwij+e_augm
1818 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1819 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1820 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1821 & restyp(itypi),i,restyp(itypj),j,
1822 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1823 & chi1,chi2,chip1,chip2,
1824 & eps1,eps2rt**2,eps3rt**2,
1825 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1828 C Calculate gradient components.
1829 e1=e1*eps1*eps2rt**2*eps3rt**2
1830 fac=-expon*(e1+evdwij)*rij_shift
1832 fac=rij*fac-2*expon*rrij*e_augm
1833 C Calculate the radial part of the gradient
1837 C Calculate angular part of the gradient.
1839 if (bb(itypi,itypj).gt.0) then
1851 C-----------------------------------------------------------------------------
1852 subroutine sc_angular
1853 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1854 C om12. Called by ebp, egb, and egbv.
1856 include 'COMMON.CALC'
1857 include 'COMMON.IOUNITS'
1861 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1862 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1863 om12=dxi*dxj+dyi*dyj+dzi*dzj
1865 C Calculate eps1(om12) and its derivative in om12
1866 faceps1=1.0D0-om12*chiom12
1867 faceps1_inv=1.0D0/faceps1
1868 eps1=dsqrt(faceps1_inv)
1869 C Following variable is eps1*deps1/dom12
1870 eps1_om12=faceps1_inv*chiom12
1875 c write (iout,*) "om12",om12," eps1",eps1
1876 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1881 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1882 sigsq=1.0D0-facsig*faceps1_inv
1883 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1884 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1885 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1891 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1892 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1894 C Calculate eps2 and its derivatives in om1, om2, and om12.
1897 chipom12=chip12*om12
1898 facp=1.0D0-om12*chipom12
1900 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1901 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1902 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1903 C Following variable is the square root of eps2
1904 eps2rt=1.0D0-facp1*facp_inv
1905 C Following three variables are the derivatives of the square root of eps
1906 C in om1, om2, and om12.
1907 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1908 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1909 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1910 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1911 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1912 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1913 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1914 c & " eps2rt_om12",eps2rt_om12
1915 C Calculate whole angle-dependent part of epsilon and contributions
1916 C to its derivatives
1920 C----------------------------------------------------------------------------
1921 subroutine sc_grad_T
1922 implicit real*8 (a-h,o-z)
1923 include 'DIMENSIONS'
1924 include 'COMMON.CHAIN'
1925 include 'COMMON.DERIV'
1926 include 'COMMON.CALC'
1927 include 'COMMON.IOUNITS'
1928 double precision dcosom1(3),dcosom2(3)
1929 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1930 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1931 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1932 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1936 c eom12=evdwij*eps1_om12
1938 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1939 c & " sigder",sigder
1940 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1941 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1943 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1944 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1947 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1949 c write (iout,*) "gg",(gg(k),k=1,3)
1951 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1952 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1953 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1954 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1955 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1956 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1957 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1958 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1959 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1960 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1963 C Calculate the components of the gradient in DC and X
1967 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1971 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1972 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1977 C----------------------------------------------------------------------------
1979 implicit real*8 (a-h,o-z)
1980 include 'DIMENSIONS'
1981 include 'COMMON.CHAIN'
1982 include 'COMMON.DERIV'
1983 include 'COMMON.CALC'
1984 include 'COMMON.IOUNITS'
1985 double precision dcosom1(3),dcosom2(3)
1986 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1987 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1988 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1989 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1993 c eom12=evdwij*eps1_om12
1995 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1996 c & " sigder",sigder
1997 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1998 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2000 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2001 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2004 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2006 c write (iout,*) "gg",(gg(k),k=1,3)
2008 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2009 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2010 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2011 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2012 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2013 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2014 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2015 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2016 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2017 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2020 C Calculate the components of the gradient in DC and X
2024 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2028 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2029 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2033 C-----------------------------------------------------------------------
2034 subroutine e_softsphere(evdw)
2036 C This subroutine calculates the interaction energy of nonbonded side chains
2037 C assuming the LJ potential of interaction.
2039 implicit real*8 (a-h,o-z)
2040 include 'DIMENSIONS'
2041 parameter (accur=1.0d-10)
2042 include 'COMMON.GEO'
2043 include 'COMMON.VAR'
2044 include 'COMMON.LOCAL'
2045 include 'COMMON.CHAIN'
2046 include 'COMMON.DERIV'
2047 include 'COMMON.INTERACT'
2048 include 'COMMON.TORSION'
2049 include 'COMMON.SBRIDGE'
2050 include 'COMMON.NAMES'
2051 include 'COMMON.IOUNITS'
2052 include 'COMMON.CONTACTS'
2054 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2056 do i=iatsc_s,iatsc_e
2063 C Calculate SC interaction energy.
2065 do iint=1,nint_gr(i)
2066 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2067 cd & 'iend=',iend(i,iint)
2068 do j=istart(i,iint),iend(i,iint)
2073 rij=xj*xj+yj*yj+zj*zj
2074 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2075 r0ij=r0(itypi,itypj)
2077 c print *,i,j,r0ij,dsqrt(rij)
2078 if (rij.lt.r0ijsq) then
2079 evdwij=0.25d0*(rij-r0ijsq)**2
2087 C Calculate the components of the gradient in DC and X
2093 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2094 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2095 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2096 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2100 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2108 C--------------------------------------------------------------------------
2109 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2112 C Soft-sphere potential of p-p interaction
2114 implicit real*8 (a-h,o-z)
2115 include 'DIMENSIONS'
2116 include 'COMMON.CONTROL'
2117 include 'COMMON.IOUNITS'
2118 include 'COMMON.GEO'
2119 include 'COMMON.VAR'
2120 include 'COMMON.LOCAL'
2121 include 'COMMON.CHAIN'
2122 include 'COMMON.DERIV'
2123 include 'COMMON.INTERACT'
2124 include 'COMMON.CONTACTS'
2125 include 'COMMON.TORSION'
2126 include 'COMMON.VECTORS'
2127 include 'COMMON.FFIELD'
2129 cd write(iout,*) 'In EELEC_soft_sphere'
2136 do i=iatel_s,iatel_e
2140 xmedi=c(1,i)+0.5d0*dxi
2141 ymedi=c(2,i)+0.5d0*dyi
2142 zmedi=c(3,i)+0.5d0*dzi
2144 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2145 do j=ielstart(i),ielend(i)
2149 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2150 r0ij=rpp(iteli,itelj)
2155 xj=c(1,j)+0.5D0*dxj-xmedi
2156 yj=c(2,j)+0.5D0*dyj-ymedi
2157 zj=c(3,j)+0.5D0*dzj-zmedi
2158 rij=xj*xj+yj*yj+zj*zj
2159 if (rij.lt.r0ijsq) then
2160 evdw1ij=0.25d0*(rij-r0ijsq)**2
2168 C Calculate contributions to the Cartesian gradient.
2174 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2175 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2178 * Loop over residues i+1 thru j-1.
2182 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2187 cgrad do i=nnt,nct-1
2189 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2191 cgrad do j=i+1,nct-1
2193 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2199 c------------------------------------------------------------------------------
2200 subroutine vec_and_deriv
2201 implicit real*8 (a-h,o-z)
2202 include 'DIMENSIONS'
2206 include 'COMMON.IOUNITS'
2207 include 'COMMON.GEO'
2208 include 'COMMON.VAR'
2209 include 'COMMON.LOCAL'
2210 include 'COMMON.CHAIN'
2211 include 'COMMON.VECTORS'
2212 include 'COMMON.SETUP'
2213 include 'COMMON.TIME1'
2214 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2215 C Compute the local reference systems. For reference system (i), the
2216 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2217 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2219 do i=ivec_start,ivec_end
2223 if (i.eq.nres-1) then
2224 C Case of the last full residue
2225 C Compute the Z-axis
2226 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2227 costh=dcos(pi-theta(nres))
2228 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2232 C Compute the derivatives of uz
2234 uzder(2,1,1)=-dc_norm(3,i-1)
2235 uzder(3,1,1)= dc_norm(2,i-1)
2236 uzder(1,2,1)= dc_norm(3,i-1)
2238 uzder(3,2,1)=-dc_norm(1,i-1)
2239 uzder(1,3,1)=-dc_norm(2,i-1)
2240 uzder(2,3,1)= dc_norm(1,i-1)
2243 uzder(2,1,2)= dc_norm(3,i)
2244 uzder(3,1,2)=-dc_norm(2,i)
2245 uzder(1,2,2)=-dc_norm(3,i)
2247 uzder(3,2,2)= dc_norm(1,i)
2248 uzder(1,3,2)= dc_norm(2,i)
2249 uzder(2,3,2)=-dc_norm(1,i)
2251 C Compute the Y-axis
2254 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2256 C Compute the derivatives of uy
2259 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2260 & -dc_norm(k,i)*dc_norm(j,i-1)
2261 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2263 uyder(j,j,1)=uyder(j,j,1)-costh
2264 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2269 uygrad(l,k,j,i)=uyder(l,k,j)
2270 uzgrad(l,k,j,i)=uzder(l,k,j)
2274 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2275 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2276 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2277 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2280 C Compute the Z-axis
2281 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2282 costh=dcos(pi-theta(i+2))
2283 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2287 C Compute the derivatives of uz
2289 uzder(2,1,1)=-dc_norm(3,i+1)
2290 uzder(3,1,1)= dc_norm(2,i+1)
2291 uzder(1,2,1)= dc_norm(3,i+1)
2293 uzder(3,2,1)=-dc_norm(1,i+1)
2294 uzder(1,3,1)=-dc_norm(2,i+1)
2295 uzder(2,3,1)= dc_norm(1,i+1)
2298 uzder(2,1,2)= dc_norm(3,i)
2299 uzder(3,1,2)=-dc_norm(2,i)
2300 uzder(1,2,2)=-dc_norm(3,i)
2302 uzder(3,2,2)= dc_norm(1,i)
2303 uzder(1,3,2)= dc_norm(2,i)
2304 uzder(2,3,2)=-dc_norm(1,i)
2306 C Compute the Y-axis
2309 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2311 C Compute the derivatives of uy
2314 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2315 & -dc_norm(k,i)*dc_norm(j,i+1)
2316 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2318 uyder(j,j,1)=uyder(j,j,1)-costh
2319 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2324 uygrad(l,k,j,i)=uyder(l,k,j)
2325 uzgrad(l,k,j,i)=uzder(l,k,j)
2329 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2330 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2331 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2332 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2336 vbld_inv_temp(1)=vbld_inv(i+1)
2337 if (i.lt.nres-1) then
2338 vbld_inv_temp(2)=vbld_inv(i+2)
2340 vbld_inv_temp(2)=vbld_inv(i)
2345 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2346 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2351 #if defined(PARVEC) && defined(MPI)
2352 if (nfgtasks1.gt.1) then
2354 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2355 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2356 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2357 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2358 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2360 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2361 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2363 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2364 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2365 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2366 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2367 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2368 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2369 time_gather=time_gather+MPI_Wtime()-time00
2371 c if (fg_rank.eq.0) then
2372 c write (iout,*) "Arrays UY and UZ"
2374 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2381 C-----------------------------------------------------------------------------
2382 subroutine check_vecgrad
2383 implicit real*8 (a-h,o-z)
2384 include 'DIMENSIONS'
2385 include 'COMMON.IOUNITS'
2386 include 'COMMON.GEO'
2387 include 'COMMON.VAR'
2388 include 'COMMON.LOCAL'
2389 include 'COMMON.CHAIN'
2390 include 'COMMON.VECTORS'
2391 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2392 dimension uyt(3,maxres),uzt(3,maxres)
2393 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2394 double precision delta /1.0d-7/
2397 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2398 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2399 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2400 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2401 cd & (dc_norm(if90,i),if90=1,3)
2402 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2403 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2404 cd write(iout,'(a)')
2410 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2411 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2424 cd write (iout,*) 'i=',i
2426 erij(k)=dc_norm(k,i)
2430 dc_norm(k,i)=erij(k)
2432 dc_norm(j,i)=dc_norm(j,i)+delta
2433 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2435 c dc_norm(k,i)=dc_norm(k,i)/fac
2437 c write (iout,*) (dc_norm(k,i),k=1,3)
2438 c write (iout,*) (erij(k),k=1,3)
2441 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2442 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2443 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2444 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2446 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2447 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2448 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2451 dc_norm(k,i)=erij(k)
2454 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2455 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2456 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2457 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2458 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2459 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2460 cd write (iout,'(a)')
2465 C--------------------------------------------------------------------------
2466 subroutine set_matrices
2467 implicit real*8 (a-h,o-z)
2468 include 'DIMENSIONS'
2471 include "COMMON.SETUP"
2473 integer status(MPI_STATUS_SIZE)
2475 include 'COMMON.IOUNITS'
2476 include 'COMMON.GEO'
2477 include 'COMMON.VAR'
2478 include 'COMMON.LOCAL'
2479 include 'COMMON.CHAIN'
2480 include 'COMMON.DERIV'
2481 include 'COMMON.INTERACT'
2482 include 'COMMON.CONTACTS'
2483 include 'COMMON.TORSION'
2484 include 'COMMON.VECTORS'
2485 include 'COMMON.FFIELD'
2486 double precision auxvec(2),auxmat(2,2)
2488 C Compute the virtual-bond-torsional-angle dependent quantities needed
2489 C to calculate the el-loc multibody terms of various order.
2492 do i=ivec_start+2,ivec_end+2
2496 if (i .lt. nres+1) then
2533 if (i .gt. 3 .and. i .lt. nres+1) then
2534 obrot_der(1,i-2)=-sin1
2535 obrot_der(2,i-2)= cos1
2536 Ugder(1,1,i-2)= sin1
2537 Ugder(1,2,i-2)=-cos1
2538 Ugder(2,1,i-2)=-cos1
2539 Ugder(2,2,i-2)=-sin1
2542 obrot2_der(1,i-2)=-dwasin2
2543 obrot2_der(2,i-2)= dwacos2
2544 Ug2der(1,1,i-2)= dwasin2
2545 Ug2der(1,2,i-2)=-dwacos2
2546 Ug2der(2,1,i-2)=-dwacos2
2547 Ug2der(2,2,i-2)=-dwasin2
2549 obrot_der(1,i-2)=0.0d0
2550 obrot_der(2,i-2)=0.0d0
2551 Ugder(1,1,i-2)=0.0d0
2552 Ugder(1,2,i-2)=0.0d0
2553 Ugder(2,1,i-2)=0.0d0
2554 Ugder(2,2,i-2)=0.0d0
2555 obrot2_der(1,i-2)=0.0d0
2556 obrot2_der(2,i-2)=0.0d0
2557 Ug2der(1,1,i-2)=0.0d0
2558 Ug2der(1,2,i-2)=0.0d0
2559 Ug2der(2,1,i-2)=0.0d0
2560 Ug2der(2,2,i-2)=0.0d0
2562 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2563 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2564 iti = itortyp(itype(i-2))
2568 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2569 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2570 iti1 = itortyp(itype(i-1))
2574 cd write (iout,*) '*******i',i,' iti1',iti
2575 cd write (iout,*) 'b1',b1(:,iti)
2576 cd write (iout,*) 'b2',b2(:,iti)
2577 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2578 c if (i .gt. iatel_s+2) then
2579 if (i .gt. nnt+2) then
2580 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2581 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2582 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2584 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2585 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2586 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2587 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2588 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2599 DtUg2(l,k,i-2)=0.0d0
2603 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2604 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2606 muder(k,i-2)=Ub2der(k,i-2)
2608 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2609 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2610 iti1 = itortyp(itype(i-1))
2615 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2617 cd write (iout,*) 'mu ',mu(:,i-2)
2618 cd write (iout,*) 'mu1',mu1(:,i-2)
2619 cd write (iout,*) 'mu2',mu2(:,i-2)
2620 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2622 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2623 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2624 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2625 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2626 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2627 C Vectors and matrices dependent on a single virtual-bond dihedral.
2628 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2629 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2630 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2631 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2632 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2633 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2634 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2635 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2636 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2639 C Matrices dependent on two consecutive virtual-bond dihedrals.
2640 C The order of matrices is from left to right.
2641 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2643 c do i=max0(ivec_start,2),ivec_end
2645 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2646 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2647 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2648 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2649 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2650 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2651 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2652 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2655 #if defined(MPI) && defined(PARMAT)
2657 c if (fg_rank.eq.0) then
2658 write (iout,*) "Arrays UG and UGDER before GATHER"
2660 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2661 & ((ug(l,k,i),l=1,2),k=1,2),
2662 & ((ugder(l,k,i),l=1,2),k=1,2)
2664 write (iout,*) "Arrays UG2 and UG2DER"
2666 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2667 & ((ug2(l,k,i),l=1,2),k=1,2),
2668 & ((ug2der(l,k,i),l=1,2),k=1,2)
2670 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2672 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2673 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2674 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2676 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2678 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2679 & costab(i),sintab(i),costab2(i),sintab2(i)
2681 write (iout,*) "Array MUDER"
2683 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2687 if (nfgtasks.gt.1) then
2689 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2690 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2691 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2693 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2694 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2696 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2697 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2699 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2700 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2702 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2703 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2705 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2706 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2708 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2709 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2711 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2712 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2713 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2714 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2715 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2716 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2717 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2718 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2719 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2720 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2721 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2722 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2723 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2725 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2728 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2731 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2734 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2735 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2737 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2738 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2740 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2741 & ivec_count(fg_rank1),
2742 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2744 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2745 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2747 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2748 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2750 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2751 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2753 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2754 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2756 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2757 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2759 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2760 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2762 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2763 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2765 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2766 & ivec_count(fg_rank1),
2767 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2769 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2770 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2772 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2773 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2775 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2776 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2778 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2779 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2781 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2782 & ivec_count(fg_rank1),
2783 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2785 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2786 & ivec_count(fg_rank1),
2787 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2789 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2790 & ivec_count(fg_rank1),
2791 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2792 & MPI_MAT2,FG_COMM1,IERR)
2793 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2794 & ivec_count(fg_rank1),
2795 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2796 & MPI_MAT2,FG_COMM1,IERR)
2799 c Passes matrix info through the ring
2802 if (irecv.lt.0) irecv=nfgtasks1-1
2805 if (inext.ge.nfgtasks1) inext=0
2807 c write (iout,*) "isend",isend," irecv",irecv
2809 lensend=lentyp(isend)
2810 lenrecv=lentyp(irecv)
2811 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2812 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2813 c & MPI_ROTAT1(lensend),inext,2200+isend,
2814 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2815 c & iprev,2200+irecv,FG_COMM,status,IERR)
2816 c write (iout,*) "Gather ROTAT1"
2818 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2819 c & MPI_ROTAT2(lensend),inext,3300+isend,
2820 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2821 c & iprev,3300+irecv,FG_COMM,status,IERR)
2822 c write (iout,*) "Gather ROTAT2"
2824 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2825 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2826 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2827 & iprev,4400+irecv,FG_COMM,status,IERR)
2828 c write (iout,*) "Gather ROTAT_OLD"
2830 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2831 & MPI_PRECOMP11(lensend),inext,5500+isend,
2832 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2833 & iprev,5500+irecv,FG_COMM,status,IERR)
2834 c write (iout,*) "Gather PRECOMP11"
2836 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2837 & MPI_PRECOMP12(lensend),inext,6600+isend,
2838 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2839 & iprev,6600+irecv,FG_COMM,status,IERR)
2840 c write (iout,*) "Gather PRECOMP12"
2842 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2844 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2845 & MPI_ROTAT2(lensend),inext,7700+isend,
2846 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2847 & iprev,7700+irecv,FG_COMM,status,IERR)
2848 c write (iout,*) "Gather PRECOMP21"
2850 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2851 & MPI_PRECOMP22(lensend),inext,8800+isend,
2852 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2853 & iprev,8800+irecv,FG_COMM,status,IERR)
2854 c write (iout,*) "Gather PRECOMP22"
2856 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2857 & MPI_PRECOMP23(lensend),inext,9900+isend,
2858 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2859 & MPI_PRECOMP23(lenrecv),
2860 & iprev,9900+irecv,FG_COMM,status,IERR)
2861 c write (iout,*) "Gather PRECOMP23"
2866 if (irecv.lt.0) irecv=nfgtasks1-1
2869 time_gather=time_gather+MPI_Wtime()-time00
2872 c if (fg_rank.eq.0) then
2873 write (iout,*) "Arrays UG and UGDER"
2875 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2876 & ((ug(l,k,i),l=1,2),k=1,2),
2877 & ((ugder(l,k,i),l=1,2),k=1,2)
2879 write (iout,*) "Arrays UG2 and UG2DER"
2881 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2882 & ((ug2(l,k,i),l=1,2),k=1,2),
2883 & ((ug2der(l,k,i),l=1,2),k=1,2)
2885 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2887 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2888 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2889 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2891 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2893 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2894 & costab(i),sintab(i),costab2(i),sintab2(i)
2896 write (iout,*) "Array MUDER"
2898 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2904 cd iti = itortyp(itype(i))
2907 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2908 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2913 C--------------------------------------------------------------------------
2914 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2916 C This subroutine calculates the average interaction energy and its gradient
2917 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2918 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2919 C The potential depends both on the distance of peptide-group centers and on
2920 C the orientation of the CA-CA virtual bonds.
2922 implicit real*8 (a-h,o-z)
2926 include 'DIMENSIONS'
2927 include 'COMMON.CONTROL'
2928 include 'COMMON.SETUP'
2929 include 'COMMON.IOUNITS'
2930 include 'COMMON.GEO'
2931 include 'COMMON.VAR'
2932 include 'COMMON.LOCAL'
2933 include 'COMMON.CHAIN'
2934 include 'COMMON.DERIV'
2935 include 'COMMON.INTERACT'
2936 include 'COMMON.CONTACTS'
2937 include 'COMMON.TORSION'
2938 include 'COMMON.VECTORS'
2939 include 'COMMON.FFIELD'
2940 include 'COMMON.TIME1'
2941 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2942 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2943 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2944 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2945 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2946 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2948 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2950 double precision scal_el /1.0d0/
2952 double precision scal_el /0.5d0/
2955 C 13-go grudnia roku pamietnego...
2956 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2957 & 0.0d0,1.0d0,0.0d0,
2958 & 0.0d0,0.0d0,1.0d0/
2959 cd write(iout,*) 'In EELEC'
2961 cd write(iout,*) 'Type',i
2962 cd write(iout,*) 'B1',B1(:,i)
2963 cd write(iout,*) 'B2',B2(:,i)
2964 cd write(iout,*) 'CC',CC(:,:,i)
2965 cd write(iout,*) 'DD',DD(:,:,i)
2966 cd write(iout,*) 'EE',EE(:,:,i)
2968 cd call check_vecgrad
2970 if (icheckgrad.eq.1) then
2972 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2974 dc_norm(k,i)=dc(k,i)*fac
2976 c write (iout,*) 'i',i,' fac',fac
2979 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2980 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2981 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2982 c call vec_and_deriv
2988 time_mat=time_mat+MPI_Wtime()-time01
2992 cd write (iout,*) 'i=',i
2994 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2997 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2998 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3011 cd print '(a)','Enter EELEC'
3012 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3014 gel_loc_loc(i)=0.0d0
3019 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3021 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3023 do i=iturn3_start,iturn3_end
3027 dx_normi=dc_norm(1,i)
3028 dy_normi=dc_norm(2,i)
3029 dz_normi=dc_norm(3,i)
3030 xmedi=c(1,i)+0.5d0*dxi
3031 ymedi=c(2,i)+0.5d0*dyi
3032 zmedi=c(3,i)+0.5d0*dzi
3034 call eelecij(i,i+2,ees,evdw1,eel_loc)
3035 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3036 num_cont_hb(i)=num_conti
3038 do i=iturn4_start,iturn4_end
3042 dx_normi=dc_norm(1,i)
3043 dy_normi=dc_norm(2,i)
3044 dz_normi=dc_norm(3,i)
3045 xmedi=c(1,i)+0.5d0*dxi
3046 ymedi=c(2,i)+0.5d0*dyi
3047 zmedi=c(3,i)+0.5d0*dzi
3048 num_conti=num_cont_hb(i)
3049 call eelecij(i,i+3,ees,evdw1,eel_loc)
3050 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3051 num_cont_hb(i)=num_conti
3054 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3056 do i=iatel_s,iatel_e
3060 dx_normi=dc_norm(1,i)
3061 dy_normi=dc_norm(2,i)
3062 dz_normi=dc_norm(3,i)
3063 xmedi=c(1,i)+0.5d0*dxi
3064 ymedi=c(2,i)+0.5d0*dyi
3065 zmedi=c(3,i)+0.5d0*dzi
3066 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3067 num_conti=num_cont_hb(i)
3068 do j=ielstart(i),ielend(i)
3069 call eelecij(i,j,ees,evdw1,eel_loc)
3071 num_cont_hb(i)=num_conti
3073 c write (iout,*) "Number of loop steps in EELEC:",ind
3075 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3076 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3078 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3079 ccc eel_loc=eel_loc+eello_turn3
3080 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3083 C-------------------------------------------------------------------------------
3084 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3085 implicit real*8 (a-h,o-z)
3086 include 'DIMENSIONS'
3090 include 'COMMON.CONTROL'
3091 include 'COMMON.IOUNITS'
3092 include 'COMMON.GEO'
3093 include 'COMMON.VAR'
3094 include 'COMMON.LOCAL'
3095 include 'COMMON.CHAIN'
3096 include 'COMMON.DERIV'
3097 include 'COMMON.INTERACT'
3098 include 'COMMON.CONTACTS'
3099 include 'COMMON.TORSION'
3100 include 'COMMON.VECTORS'
3101 include 'COMMON.FFIELD'
3102 include 'COMMON.TIME1'
3103 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3104 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3105 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3106 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3107 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3108 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3110 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3112 double precision scal_el /1.0d0/
3114 double precision scal_el /0.5d0/
3117 C 13-go grudnia roku pamietnego...
3118 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3119 & 0.0d0,1.0d0,0.0d0,
3120 & 0.0d0,0.0d0,1.0d0/
3121 c time00=MPI_Wtime()
3122 cd write (iout,*) "eelecij",i,j
3126 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3127 aaa=app(iteli,itelj)
3128 bbb=bpp(iteli,itelj)
3129 ael6i=ael6(iteli,itelj)
3130 ael3i=ael3(iteli,itelj)
3134 dx_normj=dc_norm(1,j)
3135 dy_normj=dc_norm(2,j)
3136 dz_normj=dc_norm(3,j)
3137 xj=c(1,j)+0.5D0*dxj-xmedi
3138 yj=c(2,j)+0.5D0*dyj-ymedi
3139 zj=c(3,j)+0.5D0*dzj-zmedi
3140 rij=xj*xj+yj*yj+zj*zj
3146 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3147 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3148 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3149 fac=cosa-3.0D0*cosb*cosg
3151 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3152 if (j.eq.i+2) ev1=scal_el*ev1
3157 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3160 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3161 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3164 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3165 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3166 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3167 cd & xmedi,ymedi,zmedi,xj,yj,zj
3169 if (energy_dec) then
3170 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3171 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3175 C Calculate contributions to the Cartesian gradient.
3178 facvdw=-6*rrmij*(ev1+evdwij)
3179 facel=-3*rrmij*(el1+eesij)
3185 * Radial derivatives. First process both termini of the fragment (i,j)
3191 c ghalf=0.5D0*ggg(k)
3192 c gelc(k,i)=gelc(k,i)+ghalf
3193 c gelc(k,j)=gelc(k,j)+ghalf
3195 c 9/28/08 AL Gradient compotents will be summed only at the end
3197 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3198 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3201 * Loop over residues i+1 thru j-1.
3205 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3212 c ghalf=0.5D0*ggg(k)
3213 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3214 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3216 c 9/28/08 AL Gradient compotents will be summed only at the end
3218 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3219 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3222 * Loop over residues i+1 thru j-1.
3226 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3233 fac=-3*rrmij*(facvdw+facvdw+facel)
3238 * Radial derivatives. First process both termini of the fragment (i,j)
3244 c ghalf=0.5D0*ggg(k)
3245 c gelc(k,i)=gelc(k,i)+ghalf
3246 c gelc(k,j)=gelc(k,j)+ghalf
3248 c 9/28/08 AL Gradient compotents will be summed only at the end
3250 gelc_long(k,j)=gelc(k,j)+ggg(k)
3251 gelc_long(k,i)=gelc(k,i)-ggg(k)
3254 * Loop over residues i+1 thru j-1.
3258 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3261 c 9/28/08 AL Gradient compotents will be summed only at the end
3266 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3267 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3273 ecosa=2.0D0*fac3*fac1+fac4
3276 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3277 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3279 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3280 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3282 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3283 cd & (dcosg(k),k=1,3)
3285 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3288 c ghalf=0.5D0*ggg(k)
3289 c gelc(k,i)=gelc(k,i)+ghalf
3290 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3291 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3292 c gelc(k,j)=gelc(k,j)+ghalf
3293 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3294 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3298 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3303 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3304 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3306 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3307 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3308 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3309 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3311 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3312 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3313 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3315 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3316 C energy of a peptide unit is assumed in the form of a second-order
3317 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3318 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3319 C are computed for EVERY pair of non-contiguous peptide groups.
3321 if (j.lt.nres-1) then
3332 muij(kkk)=mu(k,i)*mu(l,j)
3335 cd write (iout,*) 'EELEC: i',i,' j',j
3336 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3337 cd write(iout,*) 'muij',muij
3338 ury=scalar(uy(1,i),erij)
3339 urz=scalar(uz(1,i),erij)
3340 vry=scalar(uy(1,j),erij)
3341 vrz=scalar(uz(1,j),erij)
3342 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3343 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3344 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3345 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3346 fac=dsqrt(-ael6i)*r3ij
3351 cd write (iout,'(4i5,4f10.5)')
3352 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3353 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3354 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3355 cd & uy(:,j),uz(:,j)
3356 cd write (iout,'(4f10.5)')
3357 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3358 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3359 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3360 cd write (iout,'(9f10.5/)')
3361 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3362 C Derivatives of the elements of A in virtual-bond vectors
3363 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3365 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3366 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3367 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3368 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3369 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3370 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3371 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3372 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3373 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3374 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3375 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3376 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3378 C Compute radial contributions to the gradient
3396 C Add the contributions coming from er
3399 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3400 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3401 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3402 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3405 C Derivatives in DC(i)
3406 cgrad ghalf1=0.5d0*agg(k,1)
3407 cgrad ghalf2=0.5d0*agg(k,2)
3408 cgrad ghalf3=0.5d0*agg(k,3)
3409 cgrad ghalf4=0.5d0*agg(k,4)
3410 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3411 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3412 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3413 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3414 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3415 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3416 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3417 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3418 C Derivatives in DC(i+1)
3419 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3420 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3421 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3422 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3423 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3424 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3425 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3426 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3427 C Derivatives in DC(j)
3428 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3429 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3430 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3431 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3432 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3433 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3434 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3435 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3436 C Derivatives in DC(j+1) or DC(nres-1)
3437 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3438 & -3.0d0*vryg(k,3)*ury)
3439 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3440 & -3.0d0*vrzg(k,3)*ury)
3441 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3442 & -3.0d0*vryg(k,3)*urz)
3443 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3444 & -3.0d0*vrzg(k,3)*urz)
3445 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3447 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3460 aggi(k,l)=-aggi(k,l)
3461 aggi1(k,l)=-aggi1(k,l)
3462 aggj(k,l)=-aggj(k,l)
3463 aggj1(k,l)=-aggj1(k,l)
3466 if (j.lt.nres-1) then
3472 aggi(k,l)=-aggi(k,l)
3473 aggi1(k,l)=-aggi1(k,l)
3474 aggj(k,l)=-aggj(k,l)
3475 aggj1(k,l)=-aggj1(k,l)
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)
3494 IF (wel_loc.gt.0.0d0) THEN
3495 C Contribution to the local-electrostatic energy coming from the i-j pair
3496 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3498 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3500 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3501 & 'eelloc',i,j,eel_loc_ij
3503 eel_loc=eel_loc+eel_loc_ij
3504 C Partial derivatives in virtual-bond dihedral angles gamma
3506 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3507 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3508 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3509 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3510 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3511 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3512 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3514 ggg(l)=agg(l,1)*muij(1)+
3515 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3516 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3517 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3518 cgrad ghalf=0.5d0*ggg(l)
3519 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3520 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3524 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3527 C Remaining derivatives of eello
3529 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3530 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3531 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3532 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3533 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3534 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3535 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3536 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3539 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3540 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3541 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3542 & .and. num_conti.le.maxconts) then
3543 c write (iout,*) i,j," entered corr"
3545 C Calculate the contact function. The ith column of the array JCONT will
3546 C contain the numbers of atoms that make contacts with the atom I (of numbers
3547 C greater than I). The arrays FACONT and GACONT will contain the values of
3548 C the contact function and its derivative.
3549 c r0ij=1.02D0*rpp(iteli,itelj)
3550 c r0ij=1.11D0*rpp(iteli,itelj)
3551 r0ij=2.20D0*rpp(iteli,itelj)
3552 c r0ij=1.55D0*rpp(iteli,itelj)
3553 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3554 if (fcont.gt.0.0D0) then
3555 num_conti=num_conti+1
3556 if (num_conti.gt.maxconts) then
3557 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3558 & ' will skip next contacts for this conf.'
3560 jcont_hb(num_conti,i)=j
3561 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3562 cd & " jcont_hb",jcont_hb(num_conti,i)
3563 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3564 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3565 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3567 d_cont(num_conti,i)=rij
3568 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3569 C --- Electrostatic-interaction matrix ---
3570 a_chuj(1,1,num_conti,i)=a22
3571 a_chuj(1,2,num_conti,i)=a23
3572 a_chuj(2,1,num_conti,i)=a32
3573 a_chuj(2,2,num_conti,i)=a33
3574 C --- Gradient of rij
3576 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3583 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3584 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3585 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3586 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3587 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3592 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3593 C Calculate contact energies
3595 wij=cosa-3.0D0*cosb*cosg
3598 c fac3=dsqrt(-ael6i)/r0ij**3
3599 fac3=dsqrt(-ael6i)*r3ij
3600 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3601 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3602 if (ees0tmp.gt.0) then
3603 ees0pij=dsqrt(ees0tmp)
3607 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3608 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3609 if (ees0tmp.gt.0) then
3610 ees0mij=dsqrt(ees0tmp)
3615 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3616 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3617 C Diagnostics. Comment out or remove after debugging!
3618 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3619 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3620 c ees0m(num_conti,i)=0.0D0
3622 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3623 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3624 C Angular derivatives of the contact function
3625 ees0pij1=fac3/ees0pij
3626 ees0mij1=fac3/ees0mij
3627 fac3p=-3.0D0*fac3*rrmij
3628 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3629 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3631 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3632 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3633 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3634 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3635 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3636 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3637 ecosap=ecosa1+ecosa2
3638 ecosbp=ecosb1+ecosb2
3639 ecosgp=ecosg1+ecosg2
3640 ecosam=ecosa1-ecosa2
3641 ecosbm=ecosb1-ecosb2
3642 ecosgm=ecosg1-ecosg2
3651 facont_hb(num_conti,i)=fcont
3652 fprimcont=fprimcont/rij
3653 cd facont_hb(num_conti,i)=1.0D0
3654 C Following line is for diagnostics.
3657 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3658 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3661 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3662 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3664 gggp(1)=gggp(1)+ees0pijp*xj
3665 gggp(2)=gggp(2)+ees0pijp*yj
3666 gggp(3)=gggp(3)+ees0pijp*zj
3667 gggm(1)=gggm(1)+ees0mijp*xj
3668 gggm(2)=gggm(2)+ees0mijp*yj
3669 gggm(3)=gggm(3)+ees0mijp*zj
3670 C Derivatives due to the contact function
3671 gacont_hbr(1,num_conti,i)=fprimcont*xj
3672 gacont_hbr(2,num_conti,i)=fprimcont*yj
3673 gacont_hbr(3,num_conti,i)=fprimcont*zj
3676 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3677 c following the change of gradient-summation algorithm.
3679 cgrad ghalfp=0.5D0*gggp(k)
3680 cgrad ghalfm=0.5D0*gggm(k)
3681 gacontp_hb1(k,num_conti,i)=!ghalfp
3682 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3683 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3684 gacontp_hb2(k,num_conti,i)=!ghalfp
3685 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3686 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3687 gacontp_hb3(k,num_conti,i)=gggp(k)
3688 gacontm_hb1(k,num_conti,i)=!ghalfm
3689 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3690 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3691 gacontm_hb2(k,num_conti,i)=!ghalfm
3692 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3693 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3694 gacontm_hb3(k,num_conti,i)=gggm(k)
3696 C Diagnostics. Comment out or remove after debugging!
3698 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3699 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3700 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3701 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3702 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3703 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3706 endif ! num_conti.le.maxconts
3709 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3712 ghalf=0.5d0*agg(l,k)
3713 aggi(l,k)=aggi(l,k)+ghalf
3714 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3715 aggj(l,k)=aggj(l,k)+ghalf
3718 if (j.eq.nres-1 .and. i.lt.j-2) then
3721 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3726 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3729 C-----------------------------------------------------------------------------
3730 subroutine eturn3(i,eello_turn3)
3731 C Third- and fourth-order contributions from turns
3732 implicit real*8 (a-h,o-z)
3733 include 'DIMENSIONS'
3734 include 'COMMON.IOUNITS'
3735 include 'COMMON.GEO'
3736 include 'COMMON.VAR'
3737 include 'COMMON.LOCAL'
3738 include 'COMMON.CHAIN'
3739 include 'COMMON.DERIV'
3740 include 'COMMON.INTERACT'
3741 include 'COMMON.CONTACTS'
3742 include 'COMMON.TORSION'
3743 include 'COMMON.VECTORS'
3744 include 'COMMON.FFIELD'
3745 include 'COMMON.CONTROL'
3747 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3748 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3749 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3750 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3751 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3752 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3753 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3756 c write (iout,*) "eturn3",i,j,j1,j2
3761 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3763 C Third-order contributions
3770 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3771 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3772 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3773 call transpose2(auxmat(1,1),auxmat1(1,1))
3774 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3775 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3776 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3777 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3778 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3779 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3780 cd & ' eello_turn3_num',4*eello_turn3_num
3781 C Derivatives in gamma(i)
3782 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3783 call transpose2(auxmat2(1,1),auxmat3(1,1))
3784 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3785 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3786 C Derivatives in gamma(i+1)
3787 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3788 call transpose2(auxmat2(1,1),auxmat3(1,1))
3789 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3790 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3791 & +0.5d0*(pizda(1,1)+pizda(2,2))
3792 C Cartesian derivatives
3794 c ghalf1=0.5d0*agg(l,1)
3795 c ghalf2=0.5d0*agg(l,2)
3796 c ghalf3=0.5d0*agg(l,3)
3797 c ghalf4=0.5d0*agg(l,4)
3798 a_temp(1,1)=aggi(l,1)!+ghalf1
3799 a_temp(1,2)=aggi(l,2)!+ghalf2
3800 a_temp(2,1)=aggi(l,3)!+ghalf3
3801 a_temp(2,2)=aggi(l,4)!+ghalf4
3802 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3803 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3804 & +0.5d0*(pizda(1,1)+pizda(2,2))
3805 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3806 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3807 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3808 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3809 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3810 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3811 & +0.5d0*(pizda(1,1)+pizda(2,2))
3812 a_temp(1,1)=aggj(l,1)!+ghalf1
3813 a_temp(1,2)=aggj(l,2)!+ghalf2
3814 a_temp(2,1)=aggj(l,3)!+ghalf3
3815 a_temp(2,2)=aggj(l,4)!+ghalf4
3816 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3817 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3818 & +0.5d0*(pizda(1,1)+pizda(2,2))
3819 a_temp(1,1)=aggj1(l,1)
3820 a_temp(1,2)=aggj1(l,2)
3821 a_temp(2,1)=aggj1(l,3)
3822 a_temp(2,2)=aggj1(l,4)
3823 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3824 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3825 & +0.5d0*(pizda(1,1)+pizda(2,2))
3829 C-------------------------------------------------------------------------------
3830 subroutine eturn4(i,eello_turn4)
3831 C Third- and fourth-order contributions from turns
3832 implicit real*8 (a-h,o-z)
3833 include 'DIMENSIONS'
3834 include 'COMMON.IOUNITS'
3835 include 'COMMON.GEO'
3836 include 'COMMON.VAR'
3837 include 'COMMON.LOCAL'
3838 include 'COMMON.CHAIN'
3839 include 'COMMON.DERIV'
3840 include 'COMMON.INTERACT'
3841 include 'COMMON.CONTACTS'
3842 include 'COMMON.TORSION'
3843 include 'COMMON.VECTORS'
3844 include 'COMMON.FFIELD'
3845 include 'COMMON.CONTROL'
3847 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3848 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3849 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3850 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3851 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3852 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3853 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3856 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3858 C Fourth-order contributions
3866 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3867 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3868 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3873 iti1=itortyp(itype(i+1))
3874 iti2=itortyp(itype(i+2))
3875 iti3=itortyp(itype(i+3))
3876 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3877 call transpose2(EUg(1,1,i+1),e1t(1,1))
3878 call transpose2(Eug(1,1,i+2),e2t(1,1))
3879 call transpose2(Eug(1,1,i+3),e3t(1,1))
3880 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3881 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3882 s1=scalar2(b1(1,iti2),auxvec(1))
3883 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3884 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3885 s2=scalar2(b1(1,iti1),auxvec(1))
3886 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3887 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3888 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3889 eello_turn4=eello_turn4-(s1+s2+s3)
3890 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3891 & 'eturn4',i,j,-(s1+s2+s3)
3892 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3893 cd & ' eello_turn4_num',8*eello_turn4_num
3894 C Derivatives in gamma(i)
3895 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3896 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3897 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3898 s1=scalar2(b1(1,iti2),auxvec(1))
3899 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3900 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3901 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3902 C Derivatives in gamma(i+1)
3903 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3904 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3905 s2=scalar2(b1(1,iti1),auxvec(1))
3906 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3907 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3908 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3909 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3910 C Derivatives in gamma(i+2)
3911 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3912 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3913 s1=scalar2(b1(1,iti2),auxvec(1))
3914 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3915 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3916 s2=scalar2(b1(1,iti1),auxvec(1))
3917 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3918 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3919 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3920 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3921 C Cartesian derivatives
3922 C Derivatives of this turn contributions in DC(i+2)
3923 if (j.lt.nres-1) then
3925 a_temp(1,1)=agg(l,1)
3926 a_temp(1,2)=agg(l,2)
3927 a_temp(2,1)=agg(l,3)
3928 a_temp(2,2)=agg(l,4)
3929 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3930 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3931 s1=scalar2(b1(1,iti2),auxvec(1))
3932 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3933 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3934 s2=scalar2(b1(1,iti1),auxvec(1))
3935 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3936 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3937 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3939 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3942 C Remaining derivatives of this turn contribution
3944 a_temp(1,1)=aggi(l,1)
3945 a_temp(1,2)=aggi(l,2)
3946 a_temp(2,1)=aggi(l,3)
3947 a_temp(2,2)=aggi(l,4)
3948 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3949 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3950 s1=scalar2(b1(1,iti2),auxvec(1))
3951 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3952 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3953 s2=scalar2(b1(1,iti1),auxvec(1))
3954 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3955 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3956 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3957 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3958 a_temp(1,1)=aggi1(l,1)
3959 a_temp(1,2)=aggi1(l,2)
3960 a_temp(2,1)=aggi1(l,3)
3961 a_temp(2,2)=aggi1(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+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3972 a_temp(1,1)=aggj(l,1)
3973 a_temp(1,2)=aggj(l,2)
3974 a_temp(2,1)=aggj(l,3)
3975 a_temp(2,2)=aggj(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,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3986 a_temp(1,1)=aggj1(l,1)
3987 a_temp(1,2)=aggj1(l,2)
3988 a_temp(2,1)=aggj1(l,3)
3989 a_temp(2,2)=aggj1(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 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4000 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4004 C-----------------------------------------------------------------------------
4005 subroutine vecpr(u,v,w)
4006 implicit real*8(a-h,o-z)
4007 dimension u(3),v(3),w(3)
4008 w(1)=u(2)*v(3)-u(3)*v(2)
4009 w(2)=-u(1)*v(3)+u(3)*v(1)
4010 w(3)=u(1)*v(2)-u(2)*v(1)
4013 C-----------------------------------------------------------------------------
4014 subroutine unormderiv(u,ugrad,unorm,ungrad)
4015 C This subroutine computes the derivatives of a normalized vector u, given
4016 C the derivatives computed without normalization conditions, ugrad. Returns
4019 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4020 double precision vec(3)
4021 double precision scalar
4023 c write (2,*) 'ugrad',ugrad
4026 vec(i)=scalar(ugrad(1,i),u(1))
4028 c write (2,*) 'vec',vec
4031 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4034 c write (2,*) 'ungrad',ungrad
4037 C-----------------------------------------------------------------------------
4038 subroutine escp_soft_sphere(evdw2,evdw2_14)
4040 C This subroutine calculates the excluded-volume interaction energy between
4041 C peptide-group centers and side chains and its gradient in virtual-bond and
4042 C side-chain vectors.
4044 implicit real*8 (a-h,o-z)
4045 include 'DIMENSIONS'
4046 include 'COMMON.GEO'
4047 include 'COMMON.VAR'
4048 include 'COMMON.LOCAL'
4049 include 'COMMON.CHAIN'
4050 include 'COMMON.DERIV'
4051 include 'COMMON.INTERACT'
4052 include 'COMMON.FFIELD'
4053 include 'COMMON.IOUNITS'
4054 include 'COMMON.CONTROL'
4059 cd print '(a)','Enter ESCP'
4060 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4061 do i=iatscp_s,iatscp_e
4063 xi=0.5D0*(c(1,i)+c(1,i+1))
4064 yi=0.5D0*(c(2,i)+c(2,i+1))
4065 zi=0.5D0*(c(3,i)+c(3,i+1))
4067 do iint=1,nscp_gr(i)
4069 do j=iscpstart(i,iint),iscpend(i,iint)
4071 C Uncomment following three lines for SC-p interactions
4075 C Uncomment following three lines for Ca-p interactions
4079 rij=xj*xj+yj*yj+zj*zj
4082 if (rij.lt.r0ijsq) then
4083 evdwij=0.25d0*(rij-r0ijsq)**2
4091 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4096 cgrad if (j.lt.i) then
4097 cd write (iout,*) 'j<i'
4098 C Uncomment following three lines for SC-p interactions
4100 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4103 cd write (iout,*) 'j>i'
4105 cgrad ggg(k)=-ggg(k)
4106 C Uncomment following line for SC-p interactions
4107 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4111 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4113 cgrad kstart=min0(i+1,j)
4114 cgrad kend=max0(i-1,j-1)
4115 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4116 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4117 cgrad do k=kstart,kend
4119 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4123 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4124 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4132 C-----------------------------------------------------------------------------
4133 subroutine escp(evdw2,evdw2_14)
4135 C This subroutine calculates the excluded-volume interaction energy between
4136 C peptide-group centers and side chains and its gradient in virtual-bond and
4137 C side-chain vectors.
4139 implicit real*8 (a-h,o-z)
4140 include 'DIMENSIONS'
4141 include 'COMMON.GEO'
4142 include 'COMMON.VAR'
4143 include 'COMMON.LOCAL'
4144 include 'COMMON.CHAIN'
4145 include 'COMMON.DERIV'
4146 include 'COMMON.INTERACT'
4147 include 'COMMON.FFIELD'
4148 include 'COMMON.IOUNITS'
4149 include 'COMMON.CONTROL'
4153 cd print '(a)','Enter ESCP'
4154 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4155 do i=iatscp_s,iatscp_e
4157 xi=0.5D0*(c(1,i)+c(1,i+1))
4158 yi=0.5D0*(c(2,i)+c(2,i+1))
4159 zi=0.5D0*(c(3,i)+c(3,i+1))
4161 do iint=1,nscp_gr(i)
4163 do j=iscpstart(i,iint),iscpend(i,iint)
4165 C Uncomment following three lines for SC-p interactions
4169 C Uncomment following three lines for Ca-p interactions
4173 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4175 e1=fac*fac*aad(itypj,iteli)
4176 e2=fac*bad(itypj,iteli)
4177 if (iabs(j-i) .le. 2) then
4180 evdw2_14=evdw2_14+e1+e2
4184 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4185 & 'evdw2',i,j,evdwij
4187 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4189 fac=-(evdwij+e1)*rrij
4193 cgrad if (j.lt.i) then
4194 cd write (iout,*) 'j<i'
4195 C Uncomment following three lines for SC-p interactions
4197 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4200 cd write (iout,*) 'j>i'
4202 cgrad ggg(k)=-ggg(k)
4203 C Uncomment following line for SC-p interactions
4204 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4205 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4209 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4211 cgrad kstart=min0(i+1,j)
4212 cgrad kend=max0(i-1,j-1)
4213 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4214 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4215 cgrad do k=kstart,kend
4217 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4221 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4222 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4230 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4231 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4232 gradx_scp(j,i)=expon*gradx_scp(j,i)
4235 C******************************************************************************
4239 C To save time the factor EXPON has been extracted from ALL components
4240 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4243 C******************************************************************************
4246 C--------------------------------------------------------------------------
4247 subroutine edis(ehpb)
4249 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4251 implicit real*8 (a-h,o-z)
4252 include 'DIMENSIONS'
4253 include 'COMMON.SBRIDGE'
4254 include 'COMMON.CHAIN'
4255 include 'COMMON.DERIV'
4256 include 'COMMON.VAR'
4257 include 'COMMON.INTERACT'
4258 include 'COMMON.IOUNITS'
4261 c write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4262 c write(iout,*)'link_start=',link_start,' link_end=',link_end
4263 if (link_end.eq.0) return
4264 do i=link_start,link_end
4265 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4266 C CA-CA distance used in regularization of structure.
4269 C iii and jjj point to the residues for which the distance is assigned.
4270 if (ii.gt.nres) then
4277 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4278 c & dhpb(i),dhpb1(i),forcon(i)
4279 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4280 C distance and angle dependent SS bond potential.
4281 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4282 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4283 c if (.not.dyn_ss .and. i.le.nss) then
4284 C 15/02/13 CC dynamic SSbond
4285 if (.not.dyn_ss.and.
4286 & ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4287 call ssbond_ene(iii,jjj,eij)
4289 c write (iout,*) "eij",eij
4290 else if (ii.gt.nres .and. jj.gt.nres) then
4291 c Restraints from contact prediction
4293 if (dhpb1(i).gt.0.0d0) then
4294 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4295 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4296 c write (iout,*) "beta nmr",
4297 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4301 C Get the force constant corresponding to this distance.
4303 C Calculate the contribution to energy.
4304 ehpb=ehpb+waga*rdis*rdis
4305 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4307 C Evaluate gradient.
4312 ggg(j)=fac*(c(j,jj)-c(j,ii))
4315 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4316 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4319 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4320 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4323 C Calculate the distance between the two points and its difference from the
4326 if (dhpb1(i).gt.0.0d0) then
4327 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4328 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4329 c write (iout,*) "alph nmr",
4330 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4333 C Get the force constant corresponding to this distance.
4335 C Calculate the contribution to energy.
4336 ehpb=ehpb+waga*rdis*rdis
4337 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4339 C Evaluate gradient.
4343 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4344 cd & ' waga=',waga,' fac=',fac
4346 ggg(j)=fac*(c(j,jj)-c(j,ii))
4348 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4349 C If this is a SC-SC distance, we need to calculate the contributions to the
4350 C Cartesian gradient in the SC vectors (ghpbx).
4353 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4354 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4357 cgrad do j=iii,jjj-1
4359 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4363 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4364 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4371 C--------------------------------------------------------------------------
4372 subroutine ssbond_ene(i,j,eij)
4374 C Calculate the distance and angle dependent SS-bond potential energy
4375 C using a free-energy function derived based on RHF/6-31G** ab initio
4376 C calculations of diethyl disulfide.
4378 C A. Liwo and U. Kozlowska, 11/24/03
4380 implicit real*8 (a-h,o-z)
4381 include 'DIMENSIONS'
4382 include 'COMMON.SBRIDGE'
4383 include 'COMMON.CHAIN'
4384 include 'COMMON.DERIV'
4385 include 'COMMON.LOCAL'
4386 include 'COMMON.INTERACT'
4387 include 'COMMON.VAR'
4388 include 'COMMON.IOUNITS'
4389 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4394 dxi=dc_norm(1,nres+i)
4395 dyi=dc_norm(2,nres+i)
4396 dzi=dc_norm(3,nres+i)
4397 c dsci_inv=dsc_inv(itypi)
4398 dsci_inv=vbld_inv(nres+i)
4400 c dscj_inv=dsc_inv(itypj)
4401 dscj_inv=vbld_inv(nres+j)
4405 dxj=dc_norm(1,nres+j)
4406 dyj=dc_norm(2,nres+j)
4407 dzj=dc_norm(3,nres+j)
4408 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4413 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4414 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4415 om12=dxi*dxj+dyi*dyj+dzi*dzj
4417 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4418 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4424 deltat12=om2-om1+2.0d0
4426 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4427 & +akct*deltad*deltat12+ebr
4428 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4430 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4431 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4432 c & " deltat12",deltat12," eij",eij
4433 ed=2*akcm*deltad+akct*deltat12
4435 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4436 eom1=-2*akth*deltat1-pom1-om2*pom2
4437 eom2= 2*akth*deltat2+pom1-om1*pom2
4440 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4441 ghpbx(k,i)=ghpbx(k,i)-ggk
4442 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4443 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4444 ghpbx(k,j)=ghpbx(k,j)+ggk
4445 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4446 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4447 ghpbc(k,i)=ghpbc(k,i)-ggk
4448 ghpbc(k,j)=ghpbc(k,j)+ggk
4451 C Calculate the components of the gradient in DC and X
4455 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4460 C--------------------------------------------------------------------------
4461 subroutine ebond(estr)
4463 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4465 implicit real*8 (a-h,o-z)
4466 include 'DIMENSIONS'
4467 include 'COMMON.LOCAL'
4468 include 'COMMON.GEO'
4469 include 'COMMON.INTERACT'
4470 include 'COMMON.DERIV'
4471 include 'COMMON.VAR'
4472 include 'COMMON.CHAIN'
4473 include 'COMMON.IOUNITS'
4474 include 'COMMON.NAMES'
4475 include 'COMMON.FFIELD'
4476 include 'COMMON.CONTROL'
4477 include 'COMMON.SETUP'
4478 double precision u(3),ud(3)
4480 do i=ibondp_start,ibondp_end
4481 diff = vbld(i)-vbldp0
4482 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4485 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4487 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4491 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4493 do i=ibond_start,ibond_end
4498 diff=vbld(i+nres)-vbldsc0(1,iti)
4499 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4500 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4501 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4503 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4507 diff=vbld(i+nres)-vbldsc0(j,iti)
4508 ud(j)=aksc(j,iti)*diff
4509 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4523 uprod2=uprod2*u(k)*u(k)
4527 usumsqder=usumsqder+ud(j)*uprod2
4529 estr=estr+uprod/usum
4531 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4539 C--------------------------------------------------------------------------
4540 subroutine ebend(etheta)
4542 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4543 C angles gamma and its derivatives in consecutive thetas and gammas.
4545 implicit real*8 (a-h,o-z)
4546 include 'DIMENSIONS'
4547 include 'COMMON.LOCAL'
4548 include 'COMMON.GEO'
4549 include 'COMMON.INTERACT'
4550 include 'COMMON.DERIV'
4551 include 'COMMON.VAR'
4552 include 'COMMON.CHAIN'
4553 include 'COMMON.IOUNITS'
4554 include 'COMMON.NAMES'
4555 include 'COMMON.FFIELD'
4556 include 'COMMON.CONTROL'
4557 common /calcthet/ term1,term2,termm,diffak,ratak,
4558 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4559 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4560 double precision y(2),z(2)
4562 c time11=dexp(-2*time)
4565 c write (*,'(a,i2)') 'EBEND ICG=',icg
4566 do i=ithet_start,ithet_end
4567 C Zero the energy function and its derivative at 0 or pi.
4568 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4573 if (phii.ne.phii) phii=150.0
4586 if (phii1.ne.phii1) phii1=150.0
4598 C Calculate the "mean" value of theta from the part of the distribution
4599 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4600 C In following comments this theta will be referred to as t_c.
4601 thet_pred_mean=0.0d0
4605 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4607 dthett=thet_pred_mean*ssd
4608 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4609 C Derivatives of the "mean" values in gamma1 and gamma2.
4610 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4611 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4612 if (theta(i).gt.pi-delta) then
4613 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4615 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4616 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4617 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4619 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4621 else if (theta(i).lt.delta) then
4622 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4623 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4624 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4626 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4627 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4630 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4633 etheta=etheta+ethetai
4634 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4636 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4637 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4638 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4640 C Ufff.... We've done all this!!!
4643 C---------------------------------------------------------------------------
4644 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4646 implicit real*8 (a-h,o-z)
4647 include 'DIMENSIONS'
4648 include 'COMMON.LOCAL'
4649 include 'COMMON.IOUNITS'
4650 common /calcthet/ term1,term2,termm,diffak,ratak,
4651 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4652 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4653 C Calculate the contributions to both Gaussian lobes.
4654 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4655 C The "polynomial part" of the "standard deviation" of this part of
4659 sig=sig*thet_pred_mean+polthet(j,it)
4661 C Derivative of the "interior part" of the "standard deviation of the"
4662 C gamma-dependent Gaussian lobe in t_c.
4663 sigtc=3*polthet(3,it)
4665 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4668 C Set the parameters of both Gaussian lobes of the distribution.
4669 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4670 fac=sig*sig+sigc0(it)
4673 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4674 sigsqtc=-4.0D0*sigcsq*sigtc
4675 c print *,i,sig,sigtc,sigsqtc
4676 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4677 sigtc=-sigtc/(fac*fac)
4678 C Following variable is sigma(t_c)**(-2)
4679 sigcsq=sigcsq*sigcsq
4681 sig0inv=1.0D0/sig0i**2
4682 delthec=thetai-thet_pred_mean
4683 delthe0=thetai-theta0i
4684 term1=-0.5D0*sigcsq*delthec*delthec
4685 term2=-0.5D0*sig0inv*delthe0*delthe0
4686 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4687 C NaNs in taking the logarithm. We extract the largest exponent which is added
4688 C to the energy (this being the log of the distribution) at the end of energy
4689 C term evaluation for this virtual-bond angle.
4690 if (term1.gt.term2) then
4692 term2=dexp(term2-termm)
4696 term1=dexp(term1-termm)
4699 C The ratio between the gamma-independent and gamma-dependent lobes of
4700 C the distribution is a Gaussian function of thet_pred_mean too.
4701 diffak=gthet(2,it)-thet_pred_mean
4702 ratak=diffak/gthet(3,it)**2
4703 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4704 C Let's differentiate it in thet_pred_mean NOW.
4706 C Now put together the distribution terms to make complete distribution.
4707 termexp=term1+ak*term2
4708 termpre=sigc+ak*sig0i
4709 C Contribution of the bending energy from this theta is just the -log of
4710 C the sum of the contributions from the two lobes and the pre-exponential
4711 C factor. Simple enough, isn't it?
4712 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4713 C NOW the derivatives!!!
4714 C 6/6/97 Take into account the deformation.
4715 E_theta=(delthec*sigcsq*term1
4716 & +ak*delthe0*sig0inv*term2)/termexp
4717 E_tc=((sigtc+aktc*sig0i)/termpre
4718 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4719 & aktc*term2)/termexp)
4722 c-----------------------------------------------------------------------------
4723 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4724 implicit real*8 (a-h,o-z)
4725 include 'DIMENSIONS'
4726 include 'COMMON.LOCAL'
4727 include 'COMMON.IOUNITS'
4728 common /calcthet/ term1,term2,termm,diffak,ratak,
4729 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4730 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4731 delthec=thetai-thet_pred_mean
4732 delthe0=thetai-theta0i
4733 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4734 t3 = thetai-thet_pred_mean
4738 t14 = t12+t6*sigsqtc
4740 t21 = thetai-theta0i
4746 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4747 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4748 & *(-t12*t9-ak*sig0inv*t27)
4752 C--------------------------------------------------------------------------
4753 subroutine ebend(etheta)
4755 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4756 C angles gamma and its derivatives in consecutive thetas and gammas.
4757 C ab initio-derived potentials from
4758 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4760 implicit real*8 (a-h,o-z)
4761 include 'DIMENSIONS'
4762 include 'COMMON.LOCAL'
4763 include 'COMMON.GEO'
4764 include 'COMMON.INTERACT'
4765 include 'COMMON.DERIV'
4766 include 'COMMON.VAR'
4767 include 'COMMON.CHAIN'
4768 include 'COMMON.IOUNITS'
4769 include 'COMMON.NAMES'
4770 include 'COMMON.FFIELD'
4771 include 'COMMON.CONTROL'
4772 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4773 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4774 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4775 & sinph1ph2(maxdouble,maxdouble)
4776 logical lprn /.false./, lprn1 /.false./
4778 do i=ithet_start,ithet_end
4782 theti2=0.5d0*theta(i)
4783 ityp2=ithetyp(itype(i-1))
4785 coskt(k)=dcos(k*theti2)
4786 sinkt(k)=dsin(k*theti2)
4791 if (phii.ne.phii) phii=150.0
4795 ityp1=ithetyp(itype(i-2))
4797 cosph1(k)=dcos(k*phii)
4798 sinph1(k)=dsin(k*phii)
4811 if (phii1.ne.phii1) phii1=150.0
4816 ityp3=ithetyp(itype(i))
4818 cosph2(k)=dcos(k*phii1)
4819 sinph2(k)=dsin(k*phii1)
4829 ethetai=aa0thet(ityp1,ityp2,ityp3)
4832 ccl=cosph1(l)*cosph2(k-l)
4833 ssl=sinph1(l)*sinph2(k-l)
4834 scl=sinph1(l)*cosph2(k-l)
4835 csl=cosph1(l)*sinph2(k-l)
4836 cosph1ph2(l,k)=ccl-ssl
4837 cosph1ph2(k,l)=ccl+ssl
4838 sinph1ph2(l,k)=scl+csl
4839 sinph1ph2(k,l)=scl-csl
4843 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4844 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4845 write (iout,*) "coskt and sinkt"
4847 write (iout,*) k,coskt(k),sinkt(k)
4851 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4852 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4855 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4856 & " ethetai",ethetai
4859 write (iout,*) "cosph and sinph"
4861 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4863 write (iout,*) "cosph1ph2 and sinph2ph2"
4866 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4867 & sinph1ph2(l,k),sinph1ph2(k,l)
4870 write(iout,*) "ethetai",ethetai
4874 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4875 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4876 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4877 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4878 ethetai=ethetai+sinkt(m)*aux
4879 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4880 dephii=dephii+k*sinkt(m)*(
4881 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4882 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4883 dephii1=dephii1+k*sinkt(m)*(
4884 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4885 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4887 & write (iout,*) "m",m," k",k," bbthet",
4888 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4889 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4890 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4891 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4895 & write(iout,*) "ethetai",ethetai
4899 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4900 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4901 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4902 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4903 ethetai=ethetai+sinkt(m)*aux
4904 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4905 dephii=dephii+l*sinkt(m)*(
4906 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4907 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4908 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4909 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4910 dephii1=dephii1+(k-l)*sinkt(m)*(
4911 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4912 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4913 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4914 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4916 write (iout,*) "m",m," k",k," l",l," ffthet",
4917 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4918 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4919 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4920 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4921 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4922 & cosph1ph2(k,l)*sinkt(m),
4923 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4929 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4930 & i,theta(i)*rad2deg,phii*rad2deg,
4931 & phii1*rad2deg,ethetai
4932 etheta=etheta+ethetai
4933 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4934 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4935 gloc(nphi+i-2,icg)=wang*dethetai
4941 c-----------------------------------------------------------------------------
4942 subroutine esc(escloc)
4943 C Calculate the local energy of a side chain and its derivatives in the
4944 C corresponding virtual-bond valence angles THETA and the spherical angles
4946 implicit real*8 (a-h,o-z)
4947 include 'DIMENSIONS'
4948 include 'COMMON.GEO'
4949 include 'COMMON.LOCAL'
4950 include 'COMMON.VAR'
4951 include 'COMMON.INTERACT'
4952 include 'COMMON.DERIV'
4953 include 'COMMON.CHAIN'
4954 include 'COMMON.IOUNITS'
4955 include 'COMMON.NAMES'
4956 include 'COMMON.FFIELD'
4957 include 'COMMON.CONTROL'
4958 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4959 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4960 common /sccalc/ time11,time12,time112,theti,it,nlobit
4963 c write (iout,'(a)') 'ESC'
4964 do i=loc_start,loc_end
4966 if (it.eq.10) goto 1
4968 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4969 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4970 theti=theta(i+1)-pipol
4975 if (x(2).gt.pi-delta) then
4979 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4981 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4982 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4984 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4985 & ddersc0(1),dersc(1))
4986 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4987 & ddersc0(3),dersc(3))
4989 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4991 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4992 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4993 & dersc0(2),esclocbi,dersc02)
4994 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4996 call splinthet(x(2),0.5d0*delta,ss,ssd)
5001 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5003 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5004 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5006 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5008 c write (iout,*) escloci
5009 else if (x(2).lt.delta) then
5013 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5015 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5016 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5018 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5019 & ddersc0(1),dersc(1))
5020 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5021 & ddersc0(3),dersc(3))
5023 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5025 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5026 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5027 & dersc0(2),esclocbi,dersc02)
5028 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5033 call splinthet(x(2),0.5d0*delta,ss,ssd)
5035 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5037 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5038 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5040 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5041 c write (iout,*) escloci
5043 call enesc(x,escloci,dersc,ddummy,.false.)
5046 escloc=escloc+escloci
5047 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5048 & 'escloc',i,escloci
5049 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5051 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5053 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5054 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5059 C---------------------------------------------------------------------------
5060 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5061 implicit real*8 (a-h,o-z)
5062 include 'DIMENSIONS'
5063 include 'COMMON.GEO'
5064 include 'COMMON.LOCAL'
5065 include 'COMMON.IOUNITS'
5066 common /sccalc/ time11,time12,time112,theti,it,nlobit
5067 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5068 double precision contr(maxlob,-1:1)
5070 c write (iout,*) 'it=',it,' nlobit=',nlobit
5074 if (mixed) ddersc(j)=0.0d0
5078 C Because of periodicity of the dependence of the SC energy in omega we have
5079 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5080 C To avoid underflows, first compute & store the exponents.
5088 z(k)=x(k)-censc(k,j,it)
5093 Axk=Axk+gaussc(l,k,j,it)*z(l)
5099 expfac=expfac+Ax(k,j,iii)*z(k)
5107 C As in the case of ebend, we want to avoid underflows in exponentiation and
5108 C subsequent NaNs and INFs in energy calculation.
5109 C Find the largest exponent
5113 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5117 cd print *,'it=',it,' emin=',emin
5119 C Compute the contribution to SC energy and derivatives
5124 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5125 if(adexp.ne.adexp) adexp=1.0
5128 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5130 cd print *,'j=',j,' expfac=',expfac
5131 escloc_i=escloc_i+expfac
5133 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5137 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5138 & +gaussc(k,2,j,it))*expfac
5145 dersc(1)=dersc(1)/cos(theti)**2
5146 ddersc(1)=ddersc(1)/cos(theti)**2
5149 escloci=-(dlog(escloc_i)-emin)
5151 dersc(j)=dersc(j)/escloc_i
5155 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5160 C------------------------------------------------------------------------------
5161 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5162 implicit real*8 (a-h,o-z)
5163 include 'DIMENSIONS'
5164 include 'COMMON.GEO'
5165 include 'COMMON.LOCAL'
5166 include 'COMMON.IOUNITS'
5167 common /sccalc/ time11,time12,time112,theti,it,nlobit
5168 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5169 double precision contr(maxlob)
5180 z(k)=x(k)-censc(k,j,it)
5186 Axk=Axk+gaussc(l,k,j,it)*z(l)
5192 expfac=expfac+Ax(k,j)*z(k)
5197 C As in the case of ebend, we want to avoid underflows in exponentiation and
5198 C subsequent NaNs and INFs in energy calculation.
5199 C Find the largest exponent
5202 if (emin.gt.contr(j)) emin=contr(j)
5206 C Compute the contribution to SC energy and derivatives
5210 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5211 escloc_i=escloc_i+expfac
5213 dersc(k)=dersc(k)+Ax(k,j)*expfac
5215 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5216 & +gaussc(1,2,j,it))*expfac
5220 dersc(1)=dersc(1)/cos(theti)**2
5221 dersc12=dersc12/cos(theti)**2
5222 escloci=-(dlog(escloc_i)-emin)
5224 dersc(j)=dersc(j)/escloc_i
5226 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5230 c----------------------------------------------------------------------------------
5231 subroutine esc(escloc)
5232 C Calculate the local energy of a side chain and its derivatives in the
5233 C corresponding virtual-bond valence angles THETA and the spherical angles
5234 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5235 C added by Urszula Kozlowska. 07/11/2007
5237 implicit real*8 (a-h,o-z)
5238 include 'DIMENSIONS'
5239 include 'COMMON.GEO'
5240 include 'COMMON.LOCAL'
5241 include 'COMMON.VAR'
5242 include 'COMMON.SCROT'
5243 include 'COMMON.INTERACT'
5244 include 'COMMON.DERIV'
5245 include 'COMMON.CHAIN'
5246 include 'COMMON.IOUNITS'
5247 include 'COMMON.NAMES'
5248 include 'COMMON.FFIELD'
5249 include 'COMMON.CONTROL'
5250 include 'COMMON.VECTORS'
5251 double precision x_prime(3),y_prime(3),z_prime(3)
5252 & , sumene,dsc_i,dp2_i,x(65),
5253 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5254 & de_dxx,de_dyy,de_dzz,de_dt
5255 double precision s1_t,s1_6_t,s2_t,s2_6_t
5257 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5258 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5259 & dt_dCi(3),dt_dCi1(3)
5260 common /sccalc/ time11,time12,time112,theti,it,nlobit
5263 do i=loc_start,loc_end
5264 costtab(i+1) =dcos(theta(i+1))
5265 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5266 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5267 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5268 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5269 cosfac=dsqrt(cosfac2)
5270 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5271 sinfac=dsqrt(sinfac2)
5273 if (it.eq.10) goto 1
5275 C Compute the axes of tghe local cartesian coordinates system; store in
5276 c x_prime, y_prime and z_prime
5283 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5284 C & dc_norm(3,i+nres)
5286 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5287 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5290 z_prime(j) = -uz(j,i-1)
5293 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5294 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5295 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5296 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5297 c & " xy",scalar(x_prime(1),y_prime(1)),
5298 c & " xz",scalar(x_prime(1),z_prime(1)),
5299 c & " yy",scalar(y_prime(1),y_prime(1)),
5300 c & " yz",scalar(y_prime(1),z_prime(1)),
5301 c & " zz",scalar(z_prime(1),z_prime(1))
5303 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5304 C to local coordinate system. Store in xx, yy, zz.
5310 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5311 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5312 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5319 C Compute the energy of the ith side cbain
5321 c write (2,*) "xx",xx," yy",yy," zz",zz
5324 x(j) = sc_parmin(j,it)
5327 Cc diagnostics - remove later
5329 yy1 = dsin(alph(2))*dcos(omeg(2))
5330 zz1 = -dsin(alph(2))*dsin(omeg(2))
5331 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5332 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5334 C," --- ", xx_w,yy_w,zz_w
5337 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5338 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5340 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5341 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5343 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5344 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5345 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5346 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5347 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5349 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5350 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5351 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5352 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5353 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5355 dsc_i = 0.743d0+x(61)
5357 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5358 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5359 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5360 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5361 s1=(1+x(63))/(0.1d0 + dscp1)
5362 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5363 s2=(1+x(65))/(0.1d0 + dscp2)
5364 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5365 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5366 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5367 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5369 c & dscp1,dscp2,sumene
5370 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5371 escloc = escloc + sumene
5372 c write (2,*) "i",i," escloc",sumene,escloc
5375 C This section to check the numerical derivatives of the energy of ith side
5376 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5377 C #define DEBUG in the code to turn it on.
5379 write (2,*) "sumene =",sumene
5383 write (2,*) xx,yy,zz
5384 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5385 de_dxx_num=(sumenep-sumene)/aincr
5387 write (2,*) "xx+ sumene from enesc=",sumenep
5390 write (2,*) xx,yy,zz
5391 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5392 de_dyy_num=(sumenep-sumene)/aincr
5394 write (2,*) "yy+ sumene from enesc=",sumenep
5397 write (2,*) xx,yy,zz
5398 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5399 de_dzz_num=(sumenep-sumene)/aincr
5401 write (2,*) "zz+ sumene from enesc=",sumenep
5402 costsave=cost2tab(i+1)
5403 sintsave=sint2tab(i+1)
5404 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5405 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5406 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5407 de_dt_num=(sumenep-sumene)/aincr
5408 write (2,*) " t+ sumene from enesc=",sumenep
5409 cost2tab(i+1)=costsave
5410 sint2tab(i+1)=sintsave
5411 C End of diagnostics section.
5414 C Compute the gradient of esc
5416 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5417 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5418 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5419 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5420 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5421 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5422 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5423 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5424 pom1=(sumene3*sint2tab(i+1)+sumene1)
5425 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5426 pom2=(sumene4*cost2tab(i+1)+sumene2)
5427 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5428 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5429 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5430 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5432 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5433 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5434 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5436 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5437 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5438 & +(pom1+pom2)*pom_dx
5440 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5443 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5444 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5445 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5447 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5448 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5449 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5450 & +x(59)*zz**2 +x(60)*xx*zz
5451 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5452 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5453 & +(pom1-pom2)*pom_dy
5455 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5458 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5459 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5460 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5461 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5462 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5463 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5464 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5465 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5467 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5470 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5471 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5472 & +pom1*pom_dt1+pom2*pom_dt2
5474 write(2,*), "de_dt = ", de_dt,de_dt_num
5478 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5479 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5480 cosfac2xx=cosfac2*xx
5481 sinfac2yy=sinfac2*yy
5483 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5485 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5487 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5488 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5489 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5490 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5491 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5492 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5493 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5494 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5495 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5496 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5500 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5501 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5504 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5505 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5506 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5508 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5509 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5513 dXX_Ctab(k,i)=dXX_Ci(k)
5514 dXX_C1tab(k,i)=dXX_Ci1(k)
5515 dYY_Ctab(k,i)=dYY_Ci(k)
5516 dYY_C1tab(k,i)=dYY_Ci1(k)
5517 dZZ_Ctab(k,i)=dZZ_Ci(k)
5518 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5519 dXX_XYZtab(k,i)=dXX_XYZ(k)
5520 dYY_XYZtab(k,i)=dYY_XYZ(k)
5521 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5525 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5526 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5527 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5528 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5529 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5531 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5532 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5533 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5534 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5535 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5536 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5537 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5538 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5540 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5541 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5543 C to check gradient call subroutine check_grad
5549 c------------------------------------------------------------------------------
5550 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5552 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5553 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5554 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5555 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5557 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5558 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5560 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5561 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5562 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5563 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5564 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5566 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5567 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5568 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5569 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5570 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5572 dsc_i = 0.743d0+x(61)
5574 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5575 & *(xx*cost2+yy*sint2))
5576 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5577 & *(xx*cost2-yy*sint2))
5578 s1=(1+x(63))/(0.1d0 + dscp1)
5579 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5580 s2=(1+x(65))/(0.1d0 + dscp2)
5581 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5582 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5583 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5588 c------------------------------------------------------------------------------
5589 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5591 C This procedure calculates two-body contact function g(rij) and its derivative:
5594 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5597 C where x=(rij-r0ij)/delta
5599 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5602 double precision rij,r0ij,eps0ij,fcont,fprimcont
5603 double precision x,x2,x4,delta
5607 if (x.lt.-1.0D0) then
5610 else if (x.le.1.0D0) then
5613 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5614 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5621 c------------------------------------------------------------------------------
5622 subroutine splinthet(theti,delta,ss,ssder)
5623 implicit real*8 (a-h,o-z)
5624 include 'DIMENSIONS'
5625 include 'COMMON.VAR'
5626 include 'COMMON.GEO'
5629 if (theti.gt.pipol) then
5630 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5632 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5637 c------------------------------------------------------------------------------
5638 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5640 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5641 double precision ksi,ksi2,ksi3,a1,a2,a3
5642 a1=fprim0*delta/(f1-f0)
5648 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5649 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5652 c------------------------------------------------------------------------------
5653 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5655 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5656 double precision ksi,ksi2,ksi3,a1,a2,a3
5661 a2=3*(f1x-f0x)-2*fprim0x*delta
5662 a3=fprim0x*delta-2*(f1x-f0x)
5663 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5666 C-----------------------------------------------------------------------------
5668 C-----------------------------------------------------------------------------
5669 subroutine etor(etors,edihcnstr)
5670 implicit real*8 (a-h,o-z)
5671 include 'DIMENSIONS'
5672 include 'COMMON.VAR'
5673 include 'COMMON.GEO'
5674 include 'COMMON.LOCAL'
5675 include 'COMMON.TORSION'
5676 include 'COMMON.INTERACT'
5677 include 'COMMON.DERIV'
5678 include 'COMMON.CHAIN'
5679 include 'COMMON.NAMES'
5680 include 'COMMON.IOUNITS'
5681 include 'COMMON.FFIELD'
5682 include 'COMMON.TORCNSTR'
5683 include 'COMMON.CONTROL'
5685 C Set lprn=.true. for debugging
5689 do i=iphi_start,iphi_end
5691 itori=itortyp(itype(i-2))
5692 itori1=itortyp(itype(i-1))
5695 C Proline-Proline pair is a special case...
5696 if (itori.eq.3 .and. itori1.eq.3) then
5697 if (phii.gt.-dwapi3) then
5699 fac=1.0D0/(1.0D0-cosphi)
5700 etorsi=v1(1,3,3)*fac
5701 etorsi=etorsi+etorsi
5702 etors=etors+etorsi-v1(1,3,3)
5703 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5704 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5707 v1ij=v1(j+1,itori,itori1)
5708 v2ij=v2(j+1,itori,itori1)
5711 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5712 if (energy_dec) etors_ii=etors_ii+
5713 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5714 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5718 v1ij=v1(j,itori,itori1)
5719 v2ij=v2(j,itori,itori1)
5722 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5723 if (energy_dec) etors_ii=etors_ii+
5724 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5725 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5728 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5731 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5732 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5733 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5734 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5735 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5737 ! 6/20/98 - dihedral angle constraints
5740 itori=idih_constr(i)
5743 if (difi.gt.drange(i)) then
5745 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5746 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5747 else if (difi.lt.-drange(i)) then
5749 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5750 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5752 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5753 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5755 ! write (iout,*) 'edihcnstr',edihcnstr
5758 c------------------------------------------------------------------------------
5759 subroutine etor_d(etors_d)
5763 c----------------------------------------------------------------------------
5765 subroutine etor(etors,edihcnstr)
5766 implicit real*8 (a-h,o-z)
5767 include 'DIMENSIONS'
5768 include 'COMMON.VAR'
5769 include 'COMMON.GEO'
5770 include 'COMMON.LOCAL'
5771 include 'COMMON.TORSION'
5772 include 'COMMON.INTERACT'
5773 include 'COMMON.DERIV'
5774 include 'COMMON.CHAIN'
5775 include 'COMMON.NAMES'
5776 include 'COMMON.IOUNITS'
5777 include 'COMMON.FFIELD'
5778 include 'COMMON.TORCNSTR'
5779 include 'COMMON.CONTROL'
5781 C Set lprn=.true. for debugging
5785 do i=iphi_start,iphi_end
5787 itori=itortyp(itype(i-2))
5788 itori1=itortyp(itype(i-1))
5791 C Regular cosine and sine terms
5792 do j=1,nterm(itori,itori1)
5793 v1ij=v1(j,itori,itori1)
5794 v2ij=v2(j,itori,itori1)
5797 etors=etors+v1ij*cosphi+v2ij*sinphi
5798 if (energy_dec) etors_ii=etors_ii+
5799 & v1ij*cosphi+v2ij*sinphi
5800 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5804 C E = SUM ----------------------------------- - v1
5805 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5807 cosphi=dcos(0.5d0*phii)
5808 sinphi=dsin(0.5d0*phii)
5809 do j=1,nlor(itori,itori1)
5810 vl1ij=vlor1(j,itori,itori1)
5811 vl2ij=vlor2(j,itori,itori1)
5812 vl3ij=vlor3(j,itori,itori1)
5813 pom=vl2ij*cosphi+vl3ij*sinphi
5814 pom1=1.0d0/(pom*pom+1.0d0)
5815 etors=etors+vl1ij*pom1
5816 if (energy_dec) etors_ii=etors_ii+
5819 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5821 C Subtract the constant term
5822 etors=etors-v0(itori,itori1)
5823 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5824 & 'etor',i,etors_ii-v0(itori,itori1)
5826 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5827 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5828 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5829 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5830 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5832 ! 6/20/98 - dihedral angle constraints
5834 c do i=1,ndih_constr
5835 do i=idihconstr_start,idihconstr_end
5836 itori=idih_constr(i)
5838 difi=pinorm(phii-phi0(i))
5839 if (difi.gt.drange(i)) then
5841 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5842 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5843 else if (difi.lt.-drange(i)) then
5845 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5846 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5850 c write (iout,*) "gloci", gloc(i-3,icg)
5851 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5852 cd & rad2deg*phi0(i), rad2deg*drange(i),
5853 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5855 cd write (iout,*) 'edihcnstr',edihcnstr
5858 c----------------------------------------------------------------------------
5859 subroutine etor_d(etors_d)
5860 C 6/23/01 Compute double torsional energy
5861 implicit real*8 (a-h,o-z)
5862 include 'DIMENSIONS'
5863 include 'COMMON.VAR'
5864 include 'COMMON.GEO'
5865 include 'COMMON.LOCAL'
5866 include 'COMMON.TORSION'
5867 include 'COMMON.INTERACT'
5868 include 'COMMON.DERIV'
5869 include 'COMMON.CHAIN'
5870 include 'COMMON.NAMES'
5871 include 'COMMON.IOUNITS'
5872 include 'COMMON.FFIELD'
5873 include 'COMMON.TORCNSTR'
5875 C Set lprn=.true. for debugging
5879 do i=iphid_start,iphid_end
5880 itori=itortyp(itype(i-2))
5881 itori1=itortyp(itype(i-1))
5882 itori2=itortyp(itype(i))
5887 do j=1,ntermd_1(itori,itori1,itori2)
5888 v1cij=v1c(1,j,itori,itori1,itori2)
5889 v1sij=v1s(1,j,itori,itori1,itori2)
5890 v2cij=v1c(2,j,itori,itori1,itori2)
5891 v2sij=v1s(2,j,itori,itori1,itori2)
5892 cosphi1=dcos(j*phii)
5893 sinphi1=dsin(j*phii)
5894 cosphi2=dcos(j*phii1)
5895 sinphi2=dsin(j*phii1)
5896 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5897 & v2cij*cosphi2+v2sij*sinphi2
5898 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5899 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5901 do k=2,ntermd_2(itori,itori1,itori2)
5903 v1cdij = v2c(k,l,itori,itori1,itori2)
5904 v2cdij = v2c(l,k,itori,itori1,itori2)
5905 v1sdij = v2s(k,l,itori,itori1,itori2)
5906 v2sdij = v2s(l,k,itori,itori1,itori2)
5907 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5908 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5909 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5910 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5911 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5912 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5913 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5914 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5915 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5916 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5919 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5920 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5921 c write (iout,*) "gloci", gloc(i-3,icg)
5926 c------------------------------------------------------------------------------
5927 subroutine eback_sc_corr(esccor)
5928 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5929 c conformational states; temporarily implemented as differences
5930 c between UNRES torsional potentials (dependent on three types of
5931 c residues) and the torsional potentials dependent on all 20 types
5932 c of residues computed from AM1 energy surfaces of terminally-blocked
5933 c amino-acid residues.
5934 implicit real*8 (a-h,o-z)
5935 include 'DIMENSIONS'
5936 include 'COMMON.VAR'
5937 include 'COMMON.GEO'
5938 include 'COMMON.LOCAL'
5939 include 'COMMON.TORSION'
5940 include 'COMMON.SCCOR'
5941 include 'COMMON.INTERACT'
5942 include 'COMMON.DERIV'
5943 include 'COMMON.CHAIN'
5944 include 'COMMON.NAMES'
5945 include 'COMMON.IOUNITS'
5946 include 'COMMON.FFIELD'
5947 include 'COMMON.CONTROL'
5949 C Set lprn=.true. for debugging
5952 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5954 do i=itau_start,itau_end
5956 isccori=isccortyp(itype(i-2))
5957 isccori1=isccortyp(itype(i-1))
5959 cccc Added 9 May 2012
5960 cc Tauangle is torsional engle depending on the value of first digit
5961 c(see comment below)
5962 cc Omicron is flat angle depending on the value of first digit
5963 c(see comment below)
5966 do intertyp=1,3 !intertyp
5967 cc Added 09 May 2012 (Adasko)
5968 cc Intertyp means interaction type of backbone mainchain correlation:
5969 c 1 = SC...Ca...Ca...Ca
5970 c 2 = Ca...Ca...Ca...SC
5971 c 3 = SC...Ca...Ca...SCi
5973 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5974 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5975 & (itype(i-1).eq.21)))
5976 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5977 & .or.(itype(i-2).eq.21)))
5978 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5979 & (itype(i-1).eq.21)))) cycle
5980 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5981 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5983 do j=1,nterm_sccor(isccori,isccori1)
5984 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5985 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5986 cosphi=dcos(j*tauangle(intertyp,i))
5987 sinphi=dsin(j*tauangle(intertyp,i))
5988 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5989 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5991 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5992 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5993 c &gloc_sc(intertyp,i-3,icg)
5995 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5996 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5997 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5998 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5999 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6003 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6007 c----------------------------------------------------------------------------
6008 subroutine multibody(ecorr)
6009 C This subroutine calculates multi-body contributions to energy following
6010 C the idea of Skolnick et al. If side chains I and J make a contact and
6011 C at the same time side chains I+1 and J+1 make a contact, an extra
6012 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6013 implicit real*8 (a-h,o-z)
6014 include 'DIMENSIONS'
6015 include 'COMMON.IOUNITS'
6016 include 'COMMON.DERIV'
6017 include 'COMMON.INTERACT'
6018 include 'COMMON.CONTACTS'
6019 double precision gx(3),gx1(3)
6022 C Set lprn=.true. for debugging
6026 write (iout,'(a)') 'Contact function values:'
6028 write (iout,'(i2,20(1x,i2,f10.5))')
6029 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6044 num_conti=num_cont(i)
6045 num_conti1=num_cont(i1)
6050 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6051 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6052 cd & ' ishift=',ishift
6053 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6054 C The system gains extra energy.
6055 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6056 endif ! j1==j+-ishift
6065 c------------------------------------------------------------------------------
6066 double precision function esccorr(i,j,k,l,jj,kk)
6067 implicit real*8 (a-h,o-z)
6068 include 'DIMENSIONS'
6069 include 'COMMON.IOUNITS'
6070 include 'COMMON.DERIV'
6071 include 'COMMON.INTERACT'
6072 include 'COMMON.CONTACTS'
6073 double precision gx(3),gx1(3)
6078 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6079 C Calculate the multi-body contribution to energy.
6080 C Calculate multi-body contributions to the gradient.
6081 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6082 cd & k,l,(gacont(m,kk,k),m=1,3)
6084 gx(m) =ekl*gacont(m,jj,i)
6085 gx1(m)=eij*gacont(m,kk,k)
6086 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6087 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6088 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6089 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6093 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6098 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6104 c------------------------------------------------------------------------------
6105 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6106 C This subroutine calculates multi-body contributions to hydrogen-bonding
6107 implicit real*8 (a-h,o-z)
6108 include 'DIMENSIONS'
6109 include 'COMMON.IOUNITS'
6112 parameter (max_cont=maxconts)
6113 parameter (max_dim=26)
6114 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6115 double precision zapas(max_dim,maxconts,max_fg_procs),
6116 & zapas_recv(max_dim,maxconts,max_fg_procs)
6117 common /przechowalnia/ zapas
6118 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6119 & status_array(MPI_STATUS_SIZE,maxconts*2)
6121 include 'COMMON.SETUP'
6122 include 'COMMON.FFIELD'
6123 include 'COMMON.DERIV'
6124 include 'COMMON.INTERACT'
6125 include 'COMMON.CONTACTS'
6126 include 'COMMON.CONTROL'
6127 include 'COMMON.LOCAL'
6128 double precision gx(3),gx1(3),time00
6131 C Set lprn=.true. for debugging
6136 if (nfgtasks.le.1) goto 30
6138 write (iout,'(a)') 'Contact function values before RECEIVE:'
6140 write (iout,'(2i3,50(1x,i2,f5.2))')
6141 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6142 & j=1,num_cont_hb(i))
6146 do i=1,ntask_cont_from
6149 do i=1,ntask_cont_to
6152 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6154 C Make the list of contacts to send to send to other procesors
6155 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6157 do i=iturn3_start,iturn3_end
6158 c write (iout,*) "make contact list turn3",i," num_cont",
6160 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6162 do i=iturn4_start,iturn4_end
6163 c write (iout,*) "make contact list turn4",i," num_cont",
6165 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6169 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6171 do j=1,num_cont_hb(i)
6174 iproc=iint_sent_local(k,jjc,ii)
6175 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6176 if (iproc.gt.0) then
6177 ncont_sent(iproc)=ncont_sent(iproc)+1
6178 nn=ncont_sent(iproc)
6180 zapas(2,nn,iproc)=jjc
6181 zapas(3,nn,iproc)=facont_hb(j,i)
6182 zapas(4,nn,iproc)=ees0p(j,i)
6183 zapas(5,nn,iproc)=ees0m(j,i)
6184 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6185 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6186 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6187 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6188 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6189 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6190 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6191 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6192 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6193 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6194 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6195 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6196 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6197 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6198 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6199 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6200 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6201 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6202 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6203 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6204 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6211 & "Numbers of contacts to be sent to other processors",
6212 & (ncont_sent(i),i=1,ntask_cont_to)
6213 write (iout,*) "Contacts sent"
6214 do ii=1,ntask_cont_to
6216 iproc=itask_cont_to(ii)
6217 write (iout,*) nn," contacts to processor",iproc,
6218 & " of CONT_TO_COMM group"
6220 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6228 CorrelID1=nfgtasks+fg_rank+1
6230 C Receive the numbers of needed contacts from other processors
6231 do ii=1,ntask_cont_from
6232 iproc=itask_cont_from(ii)
6234 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6235 & FG_COMM,req(ireq),IERR)
6237 c write (iout,*) "IRECV ended"
6239 C Send the number of contacts needed by other processors
6240 do ii=1,ntask_cont_to
6241 iproc=itask_cont_to(ii)
6243 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6244 & FG_COMM,req(ireq),IERR)
6246 c write (iout,*) "ISEND ended"
6247 c write (iout,*) "number of requests (nn)",ireq
6250 & call MPI_Waitall(ireq,req,status_array,ierr)
6252 c & "Numbers of contacts to be received from other processors",
6253 c & (ncont_recv(i),i=1,ntask_cont_from)
6257 do ii=1,ntask_cont_from
6258 iproc=itask_cont_from(ii)
6260 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6261 c & " of CONT_TO_COMM group"
6265 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6266 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6267 c write (iout,*) "ireq,req",ireq,req(ireq)
6270 C Send the contacts to processors that need them
6271 do ii=1,ntask_cont_to
6272 iproc=itask_cont_to(ii)
6274 c write (iout,*) nn," contacts to processor",iproc,
6275 c & " of CONT_TO_COMM group"
6278 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6279 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6280 c write (iout,*) "ireq,req",ireq,req(ireq)
6282 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6286 c write (iout,*) "number of requests (contacts)",ireq
6287 c write (iout,*) "req",(req(i),i=1,4)
6290 & call MPI_Waitall(ireq,req,status_array,ierr)
6291 do iii=1,ntask_cont_from
6292 iproc=itask_cont_from(iii)
6295 write (iout,*) "Received",nn," contacts from processor",iproc,
6296 & " of CONT_FROM_COMM group"
6299 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6304 ii=zapas_recv(1,i,iii)
6305 c Flag the received contacts to prevent double-counting
6306 jj=-zapas_recv(2,i,iii)
6307 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6309 nnn=num_cont_hb(ii)+1
6312 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6313 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6314 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6315 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6316 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6317 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6318 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6319 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6320 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6321 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6322 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6323 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6324 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6325 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6326 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6327 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6328 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6329 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6330 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6331 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6332 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6333 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6334 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6335 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6340 write (iout,'(a)') 'Contact function values after receive:'
6342 write (iout,'(2i3,50(1x,i3,f5.2))')
6343 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6344 & j=1,num_cont_hb(i))
6351 write (iout,'(a)') 'Contact function values:'
6353 write (iout,'(2i3,50(1x,i3,f5.2))')
6354 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6355 & j=1,num_cont_hb(i))
6359 C Remove the loop below after debugging !!!
6366 C Calculate the local-electrostatic correlation terms
6367 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6369 num_conti=num_cont_hb(i)
6370 num_conti1=num_cont_hb(i+1)
6377 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6378 c & ' jj=',jj,' kk=',kk
6379 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6380 & .or. j.lt.0 .and. j1.gt.0) .and.
6381 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6382 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6383 C The system gains extra energy.
6384 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6385 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6386 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6388 else if (j1.eq.j) then
6389 C Contacts I-J and I-(J+1) occur simultaneously.
6390 C The system loses extra energy.
6391 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6396 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6397 c & ' jj=',jj,' kk=',kk
6399 C Contacts I-J and (I+1)-J occur simultaneously.
6400 C The system loses extra energy.
6401 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6408 c------------------------------------------------------------------------------
6409 subroutine add_hb_contact(ii,jj,itask)
6410 implicit real*8 (a-h,o-z)
6411 include "DIMENSIONS"
6412 include "COMMON.IOUNITS"
6415 parameter (max_cont=maxconts)
6416 parameter (max_dim=26)
6417 include "COMMON.CONTACTS"
6418 double precision zapas(max_dim,maxconts,max_fg_procs),
6419 & zapas_recv(max_dim,maxconts,max_fg_procs)
6420 common /przechowalnia/ zapas
6421 integer i,j,ii,jj,iproc,itask(4),nn
6422 c write (iout,*) "itask",itask
6425 if (iproc.gt.0) then
6426 do j=1,num_cont_hb(ii)
6428 c write (iout,*) "i",ii," j",jj," jjc",jjc
6430 ncont_sent(iproc)=ncont_sent(iproc)+1
6431 nn=ncont_sent(iproc)
6432 zapas(1,nn,iproc)=ii
6433 zapas(2,nn,iproc)=jjc
6434 zapas(3,nn,iproc)=facont_hb(j,ii)
6435 zapas(4,nn,iproc)=ees0p(j,ii)
6436 zapas(5,nn,iproc)=ees0m(j,ii)
6437 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6438 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6439 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6440 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6441 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6442 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6443 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6444 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6445 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6446 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6447 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6448 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6449 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6450 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6451 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6452 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6453 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6454 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6455 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6456 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6457 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6465 c------------------------------------------------------------------------------
6466 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6468 C This subroutine calculates multi-body contributions to hydrogen-bonding
6469 implicit real*8 (a-h,o-z)
6470 include 'DIMENSIONS'
6471 include 'COMMON.IOUNITS'
6474 parameter (max_cont=maxconts)
6475 parameter (max_dim=70)
6476 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6477 double precision zapas(max_dim,maxconts,max_fg_procs),
6478 & zapas_recv(max_dim,maxconts,max_fg_procs)
6479 common /przechowalnia/ zapas
6480 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6481 & status_array(MPI_STATUS_SIZE,maxconts*2)
6483 include 'COMMON.SETUP'
6484 include 'COMMON.FFIELD'
6485 include 'COMMON.DERIV'
6486 include 'COMMON.LOCAL'
6487 include 'COMMON.INTERACT'
6488 include 'COMMON.CONTACTS'
6489 include 'COMMON.CHAIN'
6490 include 'COMMON.CONTROL'
6491 double precision gx(3),gx1(3)
6492 integer num_cont_hb_old(maxres)
6494 double precision eello4,eello5,eelo6,eello_turn6
6495 external eello4,eello5,eello6,eello_turn6
6496 C Set lprn=.true. for debugging
6501 num_cont_hb_old(i)=num_cont_hb(i)
6505 if (nfgtasks.le.1) goto 30
6507 write (iout,'(a)') 'Contact function values before RECEIVE:'
6509 write (iout,'(2i3,50(1x,i2,f5.2))')
6510 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6511 & j=1,num_cont_hb(i))
6515 do i=1,ntask_cont_from
6518 do i=1,ntask_cont_to
6521 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6523 C Make the list of contacts to send to send to other procesors
6524 do i=iturn3_start,iturn3_end
6525 c write (iout,*) "make contact list turn3",i," num_cont",
6527 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6529 do i=iturn4_start,iturn4_end
6530 c write (iout,*) "make contact list turn4",i," num_cont",
6532 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6536 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6538 do j=1,num_cont_hb(i)
6541 iproc=iint_sent_local(k,jjc,ii)
6542 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6543 if (iproc.ne.0) then
6544 ncont_sent(iproc)=ncont_sent(iproc)+1
6545 nn=ncont_sent(iproc)
6547 zapas(2,nn,iproc)=jjc
6548 zapas(3,nn,iproc)=d_cont(j,i)
6552 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6557 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6565 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6576 & "Numbers of contacts to be sent to other processors",
6577 & (ncont_sent(i),i=1,ntask_cont_to)
6578 write (iout,*) "Contacts sent"
6579 do ii=1,ntask_cont_to
6581 iproc=itask_cont_to(ii)
6582 write (iout,*) nn," contacts to processor",iproc,
6583 & " of CONT_TO_COMM group"
6585 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6593 CorrelID1=nfgtasks+fg_rank+1
6595 C Receive the numbers of needed contacts from other processors
6596 do ii=1,ntask_cont_from
6597 iproc=itask_cont_from(ii)
6599 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6600 & FG_COMM,req(ireq),IERR)
6602 c write (iout,*) "IRECV ended"
6604 C Send the number of contacts needed by other processors
6605 do ii=1,ntask_cont_to
6606 iproc=itask_cont_to(ii)
6608 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6609 & FG_COMM,req(ireq),IERR)
6611 c write (iout,*) "ISEND ended"
6612 c write (iout,*) "number of requests (nn)",ireq
6615 & call MPI_Waitall(ireq,req,status_array,ierr)
6617 c & "Numbers of contacts to be received from other processors",
6618 c & (ncont_recv(i),i=1,ntask_cont_from)
6622 do ii=1,ntask_cont_from
6623 iproc=itask_cont_from(ii)
6625 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6626 c & " of CONT_TO_COMM group"
6630 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6631 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6632 c write (iout,*) "ireq,req",ireq,req(ireq)
6635 C Send the contacts to processors that need them
6636 do ii=1,ntask_cont_to
6637 iproc=itask_cont_to(ii)
6639 c write (iout,*) nn," contacts to processor",iproc,
6640 c & " of CONT_TO_COMM group"
6643 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6644 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6645 c write (iout,*) "ireq,req",ireq,req(ireq)
6647 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6651 c write (iout,*) "number of requests (contacts)",ireq
6652 c write (iout,*) "req",(req(i),i=1,4)
6655 & call MPI_Waitall(ireq,req,status_array,ierr)
6656 do iii=1,ntask_cont_from
6657 iproc=itask_cont_from(iii)
6660 write (iout,*) "Received",nn," contacts from processor",iproc,
6661 & " of CONT_FROM_COMM group"
6664 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6669 ii=zapas_recv(1,i,iii)
6670 c Flag the received contacts to prevent double-counting
6671 jj=-zapas_recv(2,i,iii)
6672 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6674 nnn=num_cont_hb(ii)+1
6677 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6681 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6686 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6694 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6703 write (iout,'(a)') 'Contact function values after receive:'
6705 write (iout,'(2i3,50(1x,i3,5f6.3))')
6706 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6707 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6714 write (iout,'(a)') 'Contact function values:'
6716 write (iout,'(2i3,50(1x,i2,5f6.3))')
6717 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6718 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6724 C Remove the loop below after debugging !!!
6731 C Calculate the dipole-dipole interaction energies
6732 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6733 do i=iatel_s,iatel_e+1
6734 num_conti=num_cont_hb(i)
6743 C Calculate the local-electrostatic correlation terms
6744 c write (iout,*) "gradcorr5 in eello5 before loop"
6746 c write (iout,'(i5,3f10.5)')
6747 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6749 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6750 c write (iout,*) "corr loop i",i
6752 num_conti=num_cont_hb(i)
6753 num_conti1=num_cont_hb(i+1)
6760 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6761 c & ' jj=',jj,' kk=',kk
6762 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6763 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6764 & .or. j.lt.0 .and. j1.gt.0) .and.
6765 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6766 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6767 C The system gains extra energy.
6769 sqd1=dsqrt(d_cont(jj,i))
6770 sqd2=dsqrt(d_cont(kk,i1))
6771 sred_geom = sqd1*sqd2
6772 IF (sred_geom.lt.cutoff_corr) THEN
6773 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6775 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6776 cd & ' jj=',jj,' kk=',kk
6777 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6778 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6780 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6781 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6784 cd write (iout,*) 'sred_geom=',sred_geom,
6785 cd & ' ekont=',ekont,' fprim=',fprimcont,
6786 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6787 cd write (iout,*) "g_contij",g_contij
6788 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6789 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6790 call calc_eello(i,jp,i+1,jp1,jj,kk)
6791 if (wcorr4.gt.0.0d0)
6792 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6793 if (energy_dec.and.wcorr4.gt.0.0d0)
6794 1 write (iout,'(a6,4i5,0pf7.3)')
6795 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6796 c write (iout,*) "gradcorr5 before eello5"
6798 c write (iout,'(i5,3f10.5)')
6799 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6801 if (wcorr5.gt.0.0d0)
6802 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6803 c write (iout,*) "gradcorr5 after eello5"
6805 c write (iout,'(i5,3f10.5)')
6806 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6808 if (energy_dec.and.wcorr5.gt.0.0d0)
6809 1 write (iout,'(a6,4i5,0pf7.3)')
6810 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6811 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6812 cd write(2,*)'ijkl',i,jp,i+1,jp1
6813 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6814 & .or. wturn6.eq.0.0d0))then
6815 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6816 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6817 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6818 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6819 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6820 cd & 'ecorr6=',ecorr6
6821 cd write (iout,'(4e15.5)') sred_geom,
6822 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6823 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6824 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6825 else if (wturn6.gt.0.0d0
6826 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6827 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6828 eturn6=eturn6+eello_turn6(i,jj,kk)
6829 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6830 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6831 cd write (2,*) 'multibody_eello:eturn6',eturn6
6840 num_cont_hb(i)=num_cont_hb_old(i)
6842 c write (iout,*) "gradcorr5 in eello5"
6844 c write (iout,'(i5,3f10.5)')
6845 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6849 c------------------------------------------------------------------------------
6850 subroutine add_hb_contact_eello(ii,jj,itask)
6851 implicit real*8 (a-h,o-z)
6852 include "DIMENSIONS"
6853 include "COMMON.IOUNITS"
6856 parameter (max_cont=maxconts)
6857 parameter (max_dim=70)
6858 include "COMMON.CONTACTS"
6859 double precision zapas(max_dim,maxconts,max_fg_procs),
6860 & zapas_recv(max_dim,maxconts,max_fg_procs)
6861 common /przechowalnia/ zapas
6862 integer i,j,ii,jj,iproc,itask(4),nn
6863 c write (iout,*) "itask",itask
6866 if (iproc.gt.0) then
6867 do j=1,num_cont_hb(ii)
6869 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6871 ncont_sent(iproc)=ncont_sent(iproc)+1
6872 nn=ncont_sent(iproc)
6873 zapas(1,nn,iproc)=ii
6874 zapas(2,nn,iproc)=jjc
6875 zapas(3,nn,iproc)=d_cont(j,ii)
6879 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6884 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6892 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6904 c------------------------------------------------------------------------------
6905 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6906 implicit real*8 (a-h,o-z)
6907 include 'DIMENSIONS'
6908 include 'COMMON.IOUNITS'
6909 include 'COMMON.DERIV'
6910 include 'COMMON.INTERACT'
6911 include 'COMMON.CONTACTS'
6912 double precision gx(3),gx1(3)
6922 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6923 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6924 C Following 4 lines for diagnostics.
6929 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6930 c & 'Contacts ',i,j,
6931 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6932 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6934 C Calculate the multi-body contribution to energy.
6935 c ecorr=ecorr+ekont*ees
6936 C Calculate multi-body contributions to the gradient.
6937 coeffpees0pij=coeffp*ees0pij
6938 coeffmees0mij=coeffm*ees0mij
6939 coeffpees0pkl=coeffp*ees0pkl
6940 coeffmees0mkl=coeffm*ees0mkl
6942 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6943 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6944 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6945 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6946 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6947 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6948 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6949 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6950 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6951 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6952 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6953 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6954 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6955 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6956 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6957 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6958 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6959 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6960 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6961 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6962 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6963 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6964 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6965 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6966 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6971 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6972 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6973 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6974 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6979 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6980 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6981 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6982 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6985 c write (iout,*) "ehbcorr",ekont*ees
6990 C---------------------------------------------------------------------------
6991 subroutine dipole(i,j,jj)
6992 implicit real*8 (a-h,o-z)
6993 include 'DIMENSIONS'
6994 include 'COMMON.IOUNITS'
6995 include 'COMMON.CHAIN'
6996 include 'COMMON.FFIELD'
6997 include 'COMMON.DERIV'
6998 include 'COMMON.INTERACT'
6999 include 'COMMON.CONTACTS'
7000 include 'COMMON.TORSION'
7001 include 'COMMON.VAR'
7002 include 'COMMON.GEO'
7003 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7005 iti1 = itortyp(itype(i+1))
7006 if (j.lt.nres-1) then
7007 itj1 = itortyp(itype(j+1))
7012 dipi(iii,1)=Ub2(iii,i)
7013 dipderi(iii)=Ub2der(iii,i)
7014 dipi(iii,2)=b1(iii,iti1)
7015 dipj(iii,1)=Ub2(iii,j)
7016 dipderj(iii)=Ub2der(iii,j)
7017 dipj(iii,2)=b1(iii,itj1)
7021 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7024 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7031 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7035 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7040 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7041 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7043 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7045 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7047 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7052 C---------------------------------------------------------------------------
7053 subroutine calc_eello(i,j,k,l,jj,kk)
7055 C This subroutine computes matrices and vectors needed to calculate
7056 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7058 implicit real*8 (a-h,o-z)
7059 include 'DIMENSIONS'
7060 include 'COMMON.IOUNITS'
7061 include 'COMMON.CHAIN'
7062 include 'COMMON.DERIV'
7063 include 'COMMON.INTERACT'
7064 include 'COMMON.CONTACTS'
7065 include 'COMMON.TORSION'
7066 include 'COMMON.VAR'
7067 include 'COMMON.GEO'
7068 include 'COMMON.FFIELD'
7069 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7070 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7073 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7074 cd & ' jj=',jj,' kk=',kk
7075 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7076 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7077 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7080 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7081 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7084 call transpose2(aa1(1,1),aa1t(1,1))
7085 call transpose2(aa2(1,1),aa2t(1,1))
7088 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7089 & aa1tder(1,1,lll,kkk))
7090 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7091 & aa2tder(1,1,lll,kkk))
7095 C parallel orientation of the two CA-CA-CA frames.
7097 iti=itortyp(itype(i))
7101 itk1=itortyp(itype(k+1))
7102 itj=itortyp(itype(j))
7103 if (l.lt.nres-1) then
7104 itl1=itortyp(itype(l+1))
7108 C A1 kernel(j+1) A2T
7110 cd write (iout,'(3f10.5,5x,3f10.5)')
7111 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7113 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7114 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7115 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7116 C Following matrices are needed only for 6-th order cumulants
7117 IF (wcorr6.gt.0.0d0) THEN
7118 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7119 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7120 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7121 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7122 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7123 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7124 & ADtEAderx(1,1,1,1,1,1))
7126 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7127 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7128 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7129 & ADtEA1derx(1,1,1,1,1,1))
7131 C End 6-th order cumulants
7134 cd write (2,*) 'In calc_eello6'
7136 cd write (2,*) 'iii=',iii
7138 cd write (2,*) 'kkk=',kkk
7140 cd write (2,'(3(2f10.5),5x)')
7141 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7146 call transpose2(EUgder(1,1,k),auxmat(1,1))
7147 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7148 call transpose2(EUg(1,1,k),auxmat(1,1))
7149 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7150 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7154 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7155 & EAEAderx(1,1,lll,kkk,iii,1))
7159 C A1T kernel(i+1) A2
7160 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7161 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7162 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7163 C Following matrices are needed only for 6-th order cumulants
7164 IF (wcorr6.gt.0.0d0) THEN
7165 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7166 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7167 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7168 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7169 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7170 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7171 & ADtEAderx(1,1,1,1,1,2))
7172 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7173 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7174 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7175 & ADtEA1derx(1,1,1,1,1,2))
7177 C End 6-th order cumulants
7178 call transpose2(EUgder(1,1,l),auxmat(1,1))
7179 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7180 call transpose2(EUg(1,1,l),auxmat(1,1))
7181 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7182 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7186 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7187 & EAEAderx(1,1,lll,kkk,iii,2))
7192 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7193 C They are needed only when the fifth- or the sixth-order cumulants are
7195 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7196 call transpose2(AEA(1,1,1),auxmat(1,1))
7197 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7198 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7199 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7200 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7201 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7202 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7203 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7204 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7205 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7206 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7207 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7208 call transpose2(AEA(1,1,2),auxmat(1,1))
7209 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7210 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7211 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7212 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7213 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7214 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7215 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7216 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7217 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7218 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7219 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7220 C Calculate the Cartesian derivatives of the vectors.
7224 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7225 call matvec2(auxmat(1,1),b1(1,iti),
7226 & AEAb1derx(1,lll,kkk,iii,1,1))
7227 call matvec2(auxmat(1,1),Ub2(1,i),
7228 & AEAb2derx(1,lll,kkk,iii,1,1))
7229 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7230 & AEAb1derx(1,lll,kkk,iii,2,1))
7231 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7232 & AEAb2derx(1,lll,kkk,iii,2,1))
7233 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7234 call matvec2(auxmat(1,1),b1(1,itj),
7235 & AEAb1derx(1,lll,kkk,iii,1,2))
7236 call matvec2(auxmat(1,1),Ub2(1,j),
7237 & AEAb2derx(1,lll,kkk,iii,1,2))
7238 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7239 & AEAb1derx(1,lll,kkk,iii,2,2))
7240 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7241 & AEAb2derx(1,lll,kkk,iii,2,2))
7248 C Antiparallel orientation of the two CA-CA-CA frames.
7250 iti=itortyp(itype(i))
7254 itk1=itortyp(itype(k+1))
7255 itl=itortyp(itype(l))
7256 itj=itortyp(itype(j))
7257 if (j.lt.nres-1) then
7258 itj1=itortyp(itype(j+1))
7262 C A2 kernel(j-1)T A1T
7263 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7264 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7265 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7266 C Following matrices are needed only for 6-th order cumulants
7267 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7268 & j.eq.i+4 .and. l.eq.i+3)) THEN
7269 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7270 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7271 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7272 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7273 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7274 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7275 & ADtEAderx(1,1,1,1,1,1))
7276 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7277 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7278 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7279 & ADtEA1derx(1,1,1,1,1,1))
7281 C End 6-th order cumulants
7282 call transpose2(EUgder(1,1,k),auxmat(1,1))
7283 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7284 call transpose2(EUg(1,1,k),auxmat(1,1))
7285 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7286 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7290 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7291 & EAEAderx(1,1,lll,kkk,iii,1))
7295 C A2T kernel(i+1)T A1
7296 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7297 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7298 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7299 C Following matrices are needed only for 6-th order cumulants
7300 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7301 & j.eq.i+4 .and. l.eq.i+3)) THEN
7302 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7303 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7304 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7305 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7306 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7307 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7308 & ADtEAderx(1,1,1,1,1,2))
7309 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7310 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7311 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7312 & ADtEA1derx(1,1,1,1,1,2))
7314 C End 6-th order cumulants
7315 call transpose2(EUgder(1,1,j),auxmat(1,1))
7316 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7317 call transpose2(EUg(1,1,j),auxmat(1,1))
7318 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7319 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7323 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7324 & EAEAderx(1,1,lll,kkk,iii,2))
7329 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7330 C They are needed only when the fifth- or the sixth-order cumulants are
7332 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7333 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7334 call transpose2(AEA(1,1,1),auxmat(1,1))
7335 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7336 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7337 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7338 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7339 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7340 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7341 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7342 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7343 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7344 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7345 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7346 call transpose2(AEA(1,1,2),auxmat(1,1))
7347 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7348 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7349 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7350 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7351 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7352 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7353 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7354 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7355 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7356 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7357 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7358 C Calculate the Cartesian derivatives of the vectors.
7362 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7363 call matvec2(auxmat(1,1),b1(1,iti),
7364 & AEAb1derx(1,lll,kkk,iii,1,1))
7365 call matvec2(auxmat(1,1),Ub2(1,i),
7366 & AEAb2derx(1,lll,kkk,iii,1,1))
7367 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7368 & AEAb1derx(1,lll,kkk,iii,2,1))
7369 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7370 & AEAb2derx(1,lll,kkk,iii,2,1))
7371 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7372 call matvec2(auxmat(1,1),b1(1,itl),
7373 & AEAb1derx(1,lll,kkk,iii,1,2))
7374 call matvec2(auxmat(1,1),Ub2(1,l),
7375 & AEAb2derx(1,lll,kkk,iii,1,2))
7376 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7377 & AEAb1derx(1,lll,kkk,iii,2,2))
7378 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7379 & AEAb2derx(1,lll,kkk,iii,2,2))
7388 C---------------------------------------------------------------------------
7389 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7390 & KK,KKderg,AKA,AKAderg,AKAderx)
7394 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7395 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7396 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7401 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7403 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7406 cd if (lprn) write (2,*) 'In kernel'
7408 cd if (lprn) write (2,*) 'kkk=',kkk
7410 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7411 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7413 cd write (2,*) 'lll=',lll
7414 cd write (2,*) 'iii=1'
7416 cd write (2,'(3(2f10.5),5x)')
7417 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7420 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7421 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7423 cd write (2,*) 'lll=',lll
7424 cd write (2,*) 'iii=2'
7426 cd write (2,'(3(2f10.5),5x)')
7427 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7434 C---------------------------------------------------------------------------
7435 double precision function eello4(i,j,k,l,jj,kk)
7436 implicit real*8 (a-h,o-z)
7437 include 'DIMENSIONS'
7438 include 'COMMON.IOUNITS'
7439 include 'COMMON.CHAIN'
7440 include 'COMMON.DERIV'
7441 include 'COMMON.INTERACT'
7442 include 'COMMON.CONTACTS'
7443 include 'COMMON.TORSION'
7444 include 'COMMON.VAR'
7445 include 'COMMON.GEO'
7446 double precision pizda(2,2),ggg1(3),ggg2(3)
7447 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7451 cd print *,'eello4:',i,j,k,l,jj,kk
7452 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7453 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7454 cold eij=facont_hb(jj,i)
7455 cold ekl=facont_hb(kk,k)
7457 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7458 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7459 gcorr_loc(k-1)=gcorr_loc(k-1)
7460 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7462 gcorr_loc(l-1)=gcorr_loc(l-1)
7463 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7465 gcorr_loc(j-1)=gcorr_loc(j-1)
7466 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7471 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7472 & -EAEAderx(2,2,lll,kkk,iii,1)
7473 cd derx(lll,kkk,iii)=0.0d0
7477 cd gcorr_loc(l-1)=0.0d0
7478 cd gcorr_loc(j-1)=0.0d0
7479 cd gcorr_loc(k-1)=0.0d0
7481 cd write (iout,*)'Contacts have occurred for peptide groups',
7482 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7483 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7484 if (j.lt.nres-1) then
7491 if (l.lt.nres-1) then
7499 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7500 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7501 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7502 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7503 cgrad ghalf=0.5d0*ggg1(ll)
7504 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7505 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7506 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7507 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7508 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7509 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7510 cgrad ghalf=0.5d0*ggg2(ll)
7511 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7512 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7513 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7514 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7515 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7516 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7520 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7525 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7530 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7535 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7539 cd write (2,*) iii,gcorr_loc(iii)
7542 cd write (2,*) 'ekont',ekont
7543 cd write (iout,*) 'eello4',ekont*eel4
7546 C---------------------------------------------------------------------------
7547 double precision function eello5(i,j,k,l,jj,kk)
7548 implicit real*8 (a-h,o-z)
7549 include 'DIMENSIONS'
7550 include 'COMMON.IOUNITS'
7551 include 'COMMON.CHAIN'
7552 include 'COMMON.DERIV'
7553 include 'COMMON.INTERACT'
7554 include 'COMMON.CONTACTS'
7555 include 'COMMON.TORSION'
7556 include 'COMMON.VAR'
7557 include 'COMMON.GEO'
7558 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7559 double precision ggg1(3),ggg2(3)
7560 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7565 C /l\ / \ \ / \ / \ / C
7566 C / \ / \ \ / \ / \ / C
7567 C j| o |l1 | o | o| o | | o |o C
7568 C \ |/k\| |/ \| / |/ \| |/ \| C
7569 C \i/ \ / \ / / \ / \ C
7571 C (I) (II) (III) (IV) C
7573 C eello5_1 eello5_2 eello5_3 eello5_4 C
7575 C Antiparallel chains C
7578 C /j\ / \ \ / \ / \ / C
7579 C / \ / \ \ / \ / \ / C
7580 C j1| o |l | o | o| o | | o |o C
7581 C \ |/k\| |/ \| / |/ \| |/ \| C
7582 C \i/ \ / \ / / \ / \ C
7584 C (I) (II) (III) (IV) C
7586 C eello5_1 eello5_2 eello5_3 eello5_4 C
7588 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7590 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7591 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7596 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7598 itk=itortyp(itype(k))
7599 itl=itortyp(itype(l))
7600 itj=itortyp(itype(j))
7605 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7606 cd & eel5_3_num,eel5_4_num)
7610 derx(lll,kkk,iii)=0.0d0
7614 cd eij=facont_hb(jj,i)
7615 cd ekl=facont_hb(kk,k)
7617 cd write (iout,*)'Contacts have occurred for peptide groups',
7618 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7620 C Contribution from the graph I.
7621 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7622 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7623 call transpose2(EUg(1,1,k),auxmat(1,1))
7624 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7625 vv(1)=pizda(1,1)-pizda(2,2)
7626 vv(2)=pizda(1,2)+pizda(2,1)
7627 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7628 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7629 C Explicit gradient in virtual-dihedral angles.
7630 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7631 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7632 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7633 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7634 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7635 vv(1)=pizda(1,1)-pizda(2,2)
7636 vv(2)=pizda(1,2)+pizda(2,1)
7637 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7638 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7639 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7640 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7641 vv(1)=pizda(1,1)-pizda(2,2)
7642 vv(2)=pizda(1,2)+pizda(2,1)
7644 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7645 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7646 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7648 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7649 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7650 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7652 C Cartesian gradient
7656 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7658 vv(1)=pizda(1,1)-pizda(2,2)
7659 vv(2)=pizda(1,2)+pizda(2,1)
7660 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7661 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7662 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7668 C Contribution from graph II
7669 call transpose2(EE(1,1,itk),auxmat(1,1))
7670 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7671 vv(1)=pizda(1,1)+pizda(2,2)
7672 vv(2)=pizda(2,1)-pizda(1,2)
7673 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7674 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7675 C Explicit gradient in virtual-dihedral angles.
7676 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7677 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7678 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7679 vv(1)=pizda(1,1)+pizda(2,2)
7680 vv(2)=pizda(2,1)-pizda(1,2)
7682 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7683 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7684 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7686 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7687 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7688 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7690 C Cartesian gradient
7694 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7696 vv(1)=pizda(1,1)+pizda(2,2)
7697 vv(2)=pizda(2,1)-pizda(1,2)
7698 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7699 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7700 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7708 C Parallel orientation
7709 C Contribution from graph III
7710 call transpose2(EUg(1,1,l),auxmat(1,1))
7711 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7712 vv(1)=pizda(1,1)-pizda(2,2)
7713 vv(2)=pizda(1,2)+pizda(2,1)
7714 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7715 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7716 C Explicit gradient in virtual-dihedral angles.
7717 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7718 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7719 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7720 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7721 vv(1)=pizda(1,1)-pizda(2,2)
7722 vv(2)=pizda(1,2)+pizda(2,1)
7723 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7724 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7725 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7726 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7727 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7728 vv(1)=pizda(1,1)-pizda(2,2)
7729 vv(2)=pizda(1,2)+pizda(2,1)
7730 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7731 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7732 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7733 C Cartesian gradient
7737 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7739 vv(1)=pizda(1,1)-pizda(2,2)
7740 vv(2)=pizda(1,2)+pizda(2,1)
7741 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7742 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7743 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7748 C Contribution from graph IV
7750 call transpose2(EE(1,1,itl),auxmat(1,1))
7751 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7752 vv(1)=pizda(1,1)+pizda(2,2)
7753 vv(2)=pizda(2,1)-pizda(1,2)
7754 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7755 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7756 C Explicit gradient in virtual-dihedral angles.
7757 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7758 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7759 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7760 vv(1)=pizda(1,1)+pizda(2,2)
7761 vv(2)=pizda(2,1)-pizda(1,2)
7762 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7763 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7764 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7765 C Cartesian gradient
7769 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7771 vv(1)=pizda(1,1)+pizda(2,2)
7772 vv(2)=pizda(2,1)-pizda(1,2)
7773 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7774 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7775 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7780 C Antiparallel orientation
7781 C Contribution from graph III
7783 call transpose2(EUg(1,1,j),auxmat(1,1))
7784 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7785 vv(1)=pizda(1,1)-pizda(2,2)
7786 vv(2)=pizda(1,2)+pizda(2,1)
7787 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7788 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7789 C Explicit gradient in virtual-dihedral angles.
7790 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7791 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7792 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7793 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7794 vv(1)=pizda(1,1)-pizda(2,2)
7795 vv(2)=pizda(1,2)+pizda(2,1)
7796 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7797 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7798 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7799 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7800 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7801 vv(1)=pizda(1,1)-pizda(2,2)
7802 vv(2)=pizda(1,2)+pizda(2,1)
7803 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7804 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7805 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7806 C Cartesian gradient
7810 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7812 vv(1)=pizda(1,1)-pizda(2,2)
7813 vv(2)=pizda(1,2)+pizda(2,1)
7814 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7815 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7816 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7821 C Contribution from graph IV
7823 call transpose2(EE(1,1,itj),auxmat(1,1))
7824 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7825 vv(1)=pizda(1,1)+pizda(2,2)
7826 vv(2)=pizda(2,1)-pizda(1,2)
7827 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7828 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7829 C Explicit gradient in virtual-dihedral angles.
7830 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7831 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7832 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7833 vv(1)=pizda(1,1)+pizda(2,2)
7834 vv(2)=pizda(2,1)-pizda(1,2)
7835 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7836 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7837 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7838 C Cartesian gradient
7842 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7844 vv(1)=pizda(1,1)+pizda(2,2)
7845 vv(2)=pizda(2,1)-pizda(1,2)
7846 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7847 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7848 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7854 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7855 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7856 cd write (2,*) 'ijkl',i,j,k,l
7857 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7858 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7860 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7861 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7862 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7863 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7864 if (j.lt.nres-1) then
7871 if (l.lt.nres-1) then
7881 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7882 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7883 C summed up outside the subrouine as for the other subroutines
7884 C handling long-range interactions. The old code is commented out
7885 C with "cgrad" to keep track of changes.
7887 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7888 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7889 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7890 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7891 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7892 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7893 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7894 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7895 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7896 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7898 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7899 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7900 cgrad ghalf=0.5d0*ggg1(ll)
7902 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7903 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7904 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7905 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7906 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7907 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7908 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7909 cgrad ghalf=0.5d0*ggg2(ll)
7911 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7912 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7913 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7914 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7915 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7916 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7921 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7922 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7927 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7928 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7934 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7939 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7943 cd write (2,*) iii,g_corr5_loc(iii)
7946 cd write (2,*) 'ekont',ekont
7947 cd write (iout,*) 'eello5',ekont*eel5
7950 c--------------------------------------------------------------------------
7951 double precision function eello6(i,j,k,l,jj,kk)
7952 implicit real*8 (a-h,o-z)
7953 include 'DIMENSIONS'
7954 include 'COMMON.IOUNITS'
7955 include 'COMMON.CHAIN'
7956 include 'COMMON.DERIV'
7957 include 'COMMON.INTERACT'
7958 include 'COMMON.CONTACTS'
7959 include 'COMMON.TORSION'
7960 include 'COMMON.VAR'
7961 include 'COMMON.GEO'
7962 include 'COMMON.FFIELD'
7963 double precision ggg1(3),ggg2(3)
7964 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7969 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7977 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7978 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7982 derx(lll,kkk,iii)=0.0d0
7986 cd eij=facont_hb(jj,i)
7987 cd ekl=facont_hb(kk,k)
7993 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7994 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7995 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7996 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7997 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7998 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8000 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8001 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8002 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8003 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8004 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8005 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8009 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8011 C If turn contributions are considered, they will be handled separately.
8012 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8013 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8014 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8015 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8016 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8017 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8018 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8020 if (j.lt.nres-1) then
8027 if (l.lt.nres-1) then
8035 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8036 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8037 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8038 cgrad ghalf=0.5d0*ggg1(ll)
8040 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8041 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8042 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8043 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8044 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8045 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8046 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8047 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8048 cgrad ghalf=0.5d0*ggg2(ll)
8049 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8051 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8052 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8053 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8054 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8055 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8056 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8061 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8062 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8067 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8068 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8074 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8079 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8083 cd write (2,*) iii,g_corr6_loc(iii)
8086 cd write (2,*) 'ekont',ekont
8087 cd write (iout,*) 'eello6',ekont*eel6
8090 c--------------------------------------------------------------------------
8091 double precision function eello6_graph1(i,j,k,l,imat,swap)
8092 implicit real*8 (a-h,o-z)
8093 include 'DIMENSIONS'
8094 include 'COMMON.IOUNITS'
8095 include 'COMMON.CHAIN'
8096 include 'COMMON.DERIV'
8097 include 'COMMON.INTERACT'
8098 include 'COMMON.CONTACTS'
8099 include 'COMMON.TORSION'
8100 include 'COMMON.VAR'
8101 include 'COMMON.GEO'
8102 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8106 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8108 C Parallel Antiparallel
8114 C \ j|/k\| / \ |/k\|l /
8119 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8120 itk=itortyp(itype(k))
8121 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8122 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8123 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8124 call transpose2(EUgC(1,1,k),auxmat(1,1))
8125 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8126 vv1(1)=pizda1(1,1)-pizda1(2,2)
8127 vv1(2)=pizda1(1,2)+pizda1(2,1)
8128 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8129 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8130 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8131 s5=scalar2(vv(1),Dtobr2(1,i))
8132 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8133 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8134 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8135 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8136 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8137 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8138 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8139 & +scalar2(vv(1),Dtobr2der(1,i)))
8140 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8141 vv1(1)=pizda1(1,1)-pizda1(2,2)
8142 vv1(2)=pizda1(1,2)+pizda1(2,1)
8143 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8144 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8146 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8147 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8148 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8149 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8150 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8152 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8153 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8154 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8155 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8156 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8158 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8159 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8160 vv1(1)=pizda1(1,1)-pizda1(2,2)
8161 vv1(2)=pizda1(1,2)+pizda1(2,1)
8162 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8163 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8164 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8165 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8174 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8175 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8176 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8177 call transpose2(EUgC(1,1,k),auxmat(1,1))
8178 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8180 vv1(1)=pizda1(1,1)-pizda1(2,2)
8181 vv1(2)=pizda1(1,2)+pizda1(2,1)
8182 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8183 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8184 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8185 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8186 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8187 s5=scalar2(vv(1),Dtobr2(1,i))
8188 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8194 c----------------------------------------------------------------------------
8195 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8196 implicit real*8 (a-h,o-z)
8197 include 'DIMENSIONS'
8198 include 'COMMON.IOUNITS'
8199 include 'COMMON.CHAIN'
8200 include 'COMMON.DERIV'
8201 include 'COMMON.INTERACT'
8202 include 'COMMON.CONTACTS'
8203 include 'COMMON.TORSION'
8204 include 'COMMON.VAR'
8205 include 'COMMON.GEO'
8207 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8208 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8211 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8213 C Parallel Antiparallel C
8219 C \ j|/k\| \ |/k\|l C
8224 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8225 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8226 C AL 7/4/01 s1 would occur in the sixth-order moment,
8227 C but not in a cluster cumulant
8229 s1=dip(1,jj,i)*dip(1,kk,k)
8231 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8232 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8233 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8234 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8235 call transpose2(EUg(1,1,k),auxmat(1,1))
8236 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8237 vv(1)=pizda(1,1)-pizda(2,2)
8238 vv(2)=pizda(1,2)+pizda(2,1)
8239 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8240 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8242 eello6_graph2=-(s1+s2+s3+s4)
8244 eello6_graph2=-(s2+s3+s4)
8247 C Derivatives in gamma(i-1)
8250 s1=dipderg(1,jj,i)*dip(1,kk,k)
8252 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8253 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8254 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8255 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8257 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8259 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8261 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8263 C Derivatives in gamma(k-1)
8265 s1=dip(1,jj,i)*dipderg(1,kk,k)
8267 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8268 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8269 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8270 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8271 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8272 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8273 vv(1)=pizda(1,1)-pizda(2,2)
8274 vv(2)=pizda(1,2)+pizda(2,1)
8275 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8277 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8279 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8281 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8282 C Derivatives in gamma(j-1) or gamma(l-1)
8285 s1=dipderg(3,jj,i)*dip(1,kk,k)
8287 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8288 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8289 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8290 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8291 vv(1)=pizda(1,1)-pizda(2,2)
8292 vv(2)=pizda(1,2)+pizda(2,1)
8293 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8296 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8298 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8301 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8302 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8304 C Derivatives in gamma(l-1) or gamma(j-1)
8307 s1=dip(1,jj,i)*dipderg(3,kk,k)
8309 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8310 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8311 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8312 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8313 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8314 vv(1)=pizda(1,1)-pizda(2,2)
8315 vv(2)=pizda(1,2)+pizda(2,1)
8316 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8319 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8321 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8324 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8325 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8327 C Cartesian derivatives.
8329 write (2,*) 'In eello6_graph2'
8331 write (2,*) 'iii=',iii
8333 write (2,*) 'kkk=',kkk
8335 write (2,'(3(2f10.5),5x)')
8336 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8346 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8348 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8351 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8353 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8354 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8356 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8357 call transpose2(EUg(1,1,k),auxmat(1,1))
8358 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8360 vv(1)=pizda(1,1)-pizda(2,2)
8361 vv(2)=pizda(1,2)+pizda(2,1)
8362 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8363 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8365 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8367 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8370 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8372 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8379 c----------------------------------------------------------------------------
8380 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8381 implicit real*8 (a-h,o-z)
8382 include 'DIMENSIONS'
8383 include 'COMMON.IOUNITS'
8384 include 'COMMON.CHAIN'
8385 include 'COMMON.DERIV'
8386 include 'COMMON.INTERACT'
8387 include 'COMMON.CONTACTS'
8388 include 'COMMON.TORSION'
8389 include 'COMMON.VAR'
8390 include 'COMMON.GEO'
8391 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8393 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8395 C Parallel Antiparallel C
8401 C j|/k\| / |/k\|l / C
8406 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8408 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8409 C energy moment and not to the cluster cumulant.
8410 iti=itortyp(itype(i))
8411 if (j.lt.nres-1) then
8412 itj1=itortyp(itype(j+1))
8416 itk=itortyp(itype(k))
8417 itk1=itortyp(itype(k+1))
8418 if (l.lt.nres-1) then
8419 itl1=itortyp(itype(l+1))
8424 s1=dip(4,jj,i)*dip(4,kk,k)
8426 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8427 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8428 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8429 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8430 call transpose2(EE(1,1,itk),auxmat(1,1))
8431 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8432 vv(1)=pizda(1,1)+pizda(2,2)
8433 vv(2)=pizda(2,1)-pizda(1,2)
8434 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8435 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8436 cd & "sum",-(s2+s3+s4)
8438 eello6_graph3=-(s1+s2+s3+s4)
8440 eello6_graph3=-(s2+s3+s4)
8443 C Derivatives in gamma(k-1)
8444 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8445 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8446 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8447 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8448 C Derivatives in gamma(l-1)
8449 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8450 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8451 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8452 vv(1)=pizda(1,1)+pizda(2,2)
8453 vv(2)=pizda(2,1)-pizda(1,2)
8454 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8455 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8456 C Cartesian derivatives.
8462 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8464 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8467 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8469 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8470 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8472 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8473 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8475 vv(1)=pizda(1,1)+pizda(2,2)
8476 vv(2)=pizda(2,1)-pizda(1,2)
8477 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8479 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8481 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8484 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8486 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8488 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8494 c----------------------------------------------------------------------------
8495 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8496 implicit real*8 (a-h,o-z)
8497 include 'DIMENSIONS'
8498 include 'COMMON.IOUNITS'
8499 include 'COMMON.CHAIN'
8500 include 'COMMON.DERIV'
8501 include 'COMMON.INTERACT'
8502 include 'COMMON.CONTACTS'
8503 include 'COMMON.TORSION'
8504 include 'COMMON.VAR'
8505 include 'COMMON.GEO'
8506 include 'COMMON.FFIELD'
8507 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8508 & auxvec1(2),auxmat1(2,2)
8510 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8512 C Parallel Antiparallel C
8518 C \ j|/k\| \ |/k\|l C
8523 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8525 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8526 C energy moment and not to the cluster cumulant.
8527 cd write (2,*) 'eello_graph4: wturn6',wturn6
8528 iti=itortyp(itype(i))
8529 itj=itortyp(itype(j))
8530 if (j.lt.nres-1) then
8531 itj1=itortyp(itype(j+1))
8535 itk=itortyp(itype(k))
8536 if (k.lt.nres-1) then
8537 itk1=itortyp(itype(k+1))
8541 itl=itortyp(itype(l))
8542 if (l.lt.nres-1) then
8543 itl1=itortyp(itype(l+1))
8547 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8548 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8549 cd & ' itl',itl,' itl1',itl1
8552 s1=dip(3,jj,i)*dip(3,kk,k)
8554 s1=dip(2,jj,j)*dip(2,kk,l)
8557 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8558 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8560 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8561 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8563 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8564 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8566 call transpose2(EUg(1,1,k),auxmat(1,1))
8567 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8568 vv(1)=pizda(1,1)-pizda(2,2)
8569 vv(2)=pizda(2,1)+pizda(1,2)
8570 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8571 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8573 eello6_graph4=-(s1+s2+s3+s4)
8575 eello6_graph4=-(s2+s3+s4)
8577 C Derivatives in gamma(i-1)
8581 s1=dipderg(2,jj,i)*dip(3,kk,k)
8583 s1=dipderg(4,jj,j)*dip(2,kk,l)
8586 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8588 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8589 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8591 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8592 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8594 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8595 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8596 cd write (2,*) 'turn6 derivatives'
8598 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8600 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8604 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8606 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8610 C Derivatives in gamma(k-1)
8613 s1=dip(3,jj,i)*dipderg(2,kk,k)
8615 s1=dip(2,jj,j)*dipderg(4,kk,l)
8618 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8619 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8621 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8622 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8624 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8625 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8627 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8628 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8629 vv(1)=pizda(1,1)-pizda(2,2)
8630 vv(2)=pizda(2,1)+pizda(1,2)
8631 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8632 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8634 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8636 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8640 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8642 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8645 C Derivatives in gamma(j-1) or gamma(l-1)
8646 if (l.eq.j+1 .and. l.gt.1) then
8647 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8648 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8649 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8650 vv(1)=pizda(1,1)-pizda(2,2)
8651 vv(2)=pizda(2,1)+pizda(1,2)
8652 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8653 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8654 else if (j.gt.1) then
8655 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8656 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8657 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8658 vv(1)=pizda(1,1)-pizda(2,2)
8659 vv(2)=pizda(2,1)+pizda(1,2)
8660 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8661 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8662 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8664 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8667 C Cartesian derivatives.
8674 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8676 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8680 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8682 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8686 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8688 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8690 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8691 & b1(1,itj1),auxvec(1))
8692 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8694 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8695 & b1(1,itl1),auxvec(1))
8696 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8698 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8700 vv(1)=pizda(1,1)-pizda(2,2)
8701 vv(2)=pizda(2,1)+pizda(1,2)
8702 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8704 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8706 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8709 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8712 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8715 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8717 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8719 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8723 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8725 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8728 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8730 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8738 c----------------------------------------------------------------------------
8739 double precision function eello_turn6(i,jj,kk)
8740 implicit real*8 (a-h,o-z)
8741 include 'DIMENSIONS'
8742 include 'COMMON.IOUNITS'
8743 include 'COMMON.CHAIN'
8744 include 'COMMON.DERIV'
8745 include 'COMMON.INTERACT'
8746 include 'COMMON.CONTACTS'
8747 include 'COMMON.TORSION'
8748 include 'COMMON.VAR'
8749 include 'COMMON.GEO'
8750 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8751 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8753 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8754 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8755 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8756 C the respective energy moment and not to the cluster cumulant.
8765 iti=itortyp(itype(i))
8766 itk=itortyp(itype(k))
8767 itk1=itortyp(itype(k+1))
8768 itl=itortyp(itype(l))
8769 itj=itortyp(itype(j))
8770 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8771 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8772 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8777 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8779 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8783 derx_turn(lll,kkk,iii)=0.0d0
8790 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8792 cd write (2,*) 'eello6_5',eello6_5
8794 call transpose2(AEA(1,1,1),auxmat(1,1))
8795 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8796 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8797 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8799 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8800 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8801 s2 = scalar2(b1(1,itk),vtemp1(1))
8803 call transpose2(AEA(1,1,2),atemp(1,1))
8804 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8805 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8806 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8808 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8809 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8810 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8812 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8813 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8814 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8815 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8816 ss13 = scalar2(b1(1,itk),vtemp4(1))
8817 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8819 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8825 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8826 C Derivatives in gamma(i+2)
8830 call transpose2(AEA(1,1,1),auxmatd(1,1))
8831 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8832 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8833 call transpose2(AEAderg(1,1,2),atempd(1,1))
8834 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8835 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8837 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8838 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8839 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8845 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8846 C Derivatives in gamma(i+3)
8848 call transpose2(AEA(1,1,1),auxmatd(1,1))
8849 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8850 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8851 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8853 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8854 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8855 s2d = scalar2(b1(1,itk),vtemp1d(1))
8857 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8858 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8860 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8862 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8863 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8864 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8872 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8873 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8875 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8876 & -0.5d0*ekont*(s2d+s12d)
8878 C Derivatives in gamma(i+4)
8879 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8880 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8881 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8883 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8884 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8885 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8893 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8895 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8897 C Derivatives in gamma(i+5)
8899 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8900 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8901 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8903 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8904 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8905 s2d = scalar2(b1(1,itk),vtemp1d(1))
8907 call transpose2(AEA(1,1,2),atempd(1,1))
8908 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8909 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8911 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8912 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8914 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8915 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8916 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8924 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8925 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8927 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8928 & -0.5d0*ekont*(s2d+s12d)
8930 C Cartesian derivatives
8935 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8936 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8937 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8939 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8940 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8942 s2d = scalar2(b1(1,itk),vtemp1d(1))
8944 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8945 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8946 s8d = -(atempd(1,1)+atempd(2,2))*
8947 & scalar2(cc(1,1,itl),vtemp2(1))
8949 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8951 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8952 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8959 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8962 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8966 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8967 & - 0.5d0*(s8d+s12d)
8969 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8978 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8980 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8981 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8982 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8983 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8984 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8986 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8987 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8988 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8992 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8993 cd & 16*eel_turn6_num
8995 if (j.lt.nres-1) then
9002 if (l.lt.nres-1) then
9010 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9011 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9012 cgrad ghalf=0.5d0*ggg1(ll)
9014 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9015 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9016 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9017 & +ekont*derx_turn(ll,2,1)
9018 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9019 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9020 & +ekont*derx_turn(ll,4,1)
9021 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9022 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9023 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9024 cgrad ghalf=0.5d0*ggg2(ll)
9026 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9027 & +ekont*derx_turn(ll,2,2)
9028 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9029 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9030 & +ekont*derx_turn(ll,4,2)
9031 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9032 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9033 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9038 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9043 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9049 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9054 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9058 cd write (2,*) iii,g_corr6_loc(iii)
9060 eello_turn6=ekont*eel_turn6
9061 cd write (2,*) 'ekont',ekont
9062 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9066 C-----------------------------------------------------------------------------
9067 double precision function scalar(u,v)
9068 !DIR$ INLINEALWAYS scalar
9070 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9073 double precision u(3),v(3)
9074 cd double precision sc
9082 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9085 crc-------------------------------------------------
9086 SUBROUTINE MATVEC2(A1,V1,V2)
9087 !DIR$ INLINEALWAYS MATVEC2
9089 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9091 implicit real*8 (a-h,o-z)
9092 include 'DIMENSIONS'
9093 DIMENSION A1(2,2),V1(2),V2(2)
9097 c 3 VI=VI+A1(I,K)*V1(K)
9101 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9102 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9107 C---------------------------------------
9108 SUBROUTINE MATMAT2(A1,A2,A3)
9110 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9112 implicit real*8 (a-h,o-z)
9113 include 'DIMENSIONS'
9114 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9115 c DIMENSION AI3(2,2)
9119 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9125 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9126 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9127 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9128 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9136 c-------------------------------------------------------------------------
9137 double precision function scalar2(u,v)
9138 !DIR$ INLINEALWAYS scalar2
9140 double precision u(2),v(2)
9143 scalar2=u(1)*v(1)+u(2)*v(2)
9147 C-----------------------------------------------------------------------------
9149 subroutine transpose2(a,at)
9150 !DIR$ INLINEALWAYS transpose2
9152 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9155 double precision a(2,2),at(2,2)
9162 c--------------------------------------------------------------------------
9163 subroutine transpose(n,a,at)
9166 double precision a(n,n),at(n,n)
9174 C---------------------------------------------------------------------------
9175 subroutine prodmat3(a1,a2,kk,transp,prod)
9176 !DIR$ INLINEALWAYS prodmat3
9178 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9182 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9184 crc double precision auxmat(2,2),prod_(2,2)
9187 crc call transpose2(kk(1,1),auxmat(1,1))
9188 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9189 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9191 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9192 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9193 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9194 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9195 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9196 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9197 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9198 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9201 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9202 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9204 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9205 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9206 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9207 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9208 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9209 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9210 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9211 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9214 c call transpose2(a2(1,1),a2t(1,1))
9217 crc print *,((prod_(i,j),i=1,2),j=1,2)
9218 crc print *,((prod(i,j),i=1,2),j=1,2)