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+nss*ebr+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+nss*ebr+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)
784 write (iout,*) "gloc_sc before reduce"
787 write (iout,*) i,j,gloc_sc(j,i,icg)
794 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
798 call MPI_Barrier(FG_COMM,IERR)
799 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
801 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
802 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
803 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
804 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
805 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
806 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
807 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
808 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
809 time_reduce=time_reduce+MPI_Wtime()-time00
812 write (iout,*) "gloc_sc after reduce"
815 write (iout,*) i,j,gloc_sc(j,i,icg)
821 write (iout,*) "gloc after reduce"
823 write (iout,*) i,gloc(i,icg)
828 if (gnorm_check) then
830 c Compute the maximum elements of the gradient
840 gcorr3_turn_max=0.0d0
841 gcorr4_turn_max=0.0d0
844 gcorr6_turn_max=0.0d0
854 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
855 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
857 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
858 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
860 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
861 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
862 & gvdwc_scp_max=gvdwc_scp_norm
863 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
864 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
865 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
866 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
867 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
868 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
869 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
870 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
871 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
872 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
873 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
874 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
875 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
877 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
878 & gcorr3_turn_max=gcorr3_turn_norm
879 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
881 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
882 & gcorr4_turn_max=gcorr4_turn_norm
883 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
884 if (gradcorr5_norm.gt.gradcorr5_max)
885 & gradcorr5_max=gradcorr5_norm
886 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
887 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
888 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
890 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
891 & gcorr6_turn_max=gcorr6_turn_norm
892 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
893 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
894 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
895 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
896 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
897 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
899 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
900 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
902 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
903 if (gradx_scp_norm.gt.gradx_scp_max)
904 & gradx_scp_max=gradx_scp_norm
905 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
906 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
907 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
908 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
909 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
910 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
911 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
912 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
916 open(istat,file=statname,position="append")
918 open(istat,file=statname,access="append")
920 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
921 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
922 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
923 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
924 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
925 & gsccorx_max,gsclocx_max
927 if (gvdwc_max.gt.1.0d4) then
928 write (iout,*) "gvdwc gvdwx gradb gradbx"
930 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
931 & gradb(j,i),gradbx(j,i),j=1,3)
933 call pdbout(0.0d0,'cipiszcze',iout)
939 write (iout,*) "gradc gradx gloc"
941 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
942 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
947 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
949 time_sumgradient=time_sumgradient+tcpu()-time01
954 c-------------------------------------------------------------------------------
955 subroutine rescale_weights(t_bath)
956 implicit real*8 (a-h,o-z)
958 include 'COMMON.IOUNITS'
959 include 'COMMON.FFIELD'
960 include 'COMMON.SBRIDGE'
961 double precision kfac /2.4d0/
962 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
964 c facT=2*temp0/(t_bath+temp0)
965 if (rescale_mode.eq.0) then
971 else if (rescale_mode.eq.1) then
972 facT=kfac/(kfac-1.0d0+t_bath/temp0)
973 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
974 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
975 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
976 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
977 else if (rescale_mode.eq.2) then
983 facT=licznik/dlog(dexp(x)+dexp(-x))
984 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
985 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
986 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
987 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
989 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
990 write (*,*) "Wrong RESCALE_MODE",rescale_mode
992 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
996 welec=weights(3)*fact
997 wcorr=weights(4)*fact3
998 wcorr5=weights(5)*fact4
999 wcorr6=weights(6)*fact5
1000 wel_loc=weights(7)*fact2
1001 wturn3=weights(8)*fact2
1002 wturn4=weights(9)*fact3
1003 wturn6=weights(10)*fact5
1004 wtor=weights(13)*fact
1005 wtor_d=weights(14)*fact2
1006 wsccor=weights(21)*fact
1009 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1013 C------------------------------------------------------------------------
1014 subroutine enerprint(energia)
1015 implicit real*8 (a-h,o-z)
1016 include 'DIMENSIONS'
1017 include 'COMMON.IOUNITS'
1018 include 'COMMON.FFIELD'
1019 include 'COMMON.SBRIDGE'
1021 double precision energia(0:n_ene)
1024 evdw=energia(22)+wsct*energia(23)
1030 evdw2=energia(2)+energia(18)
1042 eello_turn3=energia(8)
1043 eello_turn4=energia(9)
1044 eello_turn6=energia(10)
1050 edihcnstr=energia(19)
1055 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1056 & estr,wbond,ebe,wang,
1057 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1059 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1060 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1061 & edihcnstr,ebr*nss,
1063 10 format (/'Virtual-chain energies:'//
1064 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1065 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1066 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1067 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1068 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1069 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1070 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1071 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1072 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1073 & 'EHPB= ',1pE16.6,' WEIGHT=',1pD16.6,
1074 & ' (SS bridges & dist. cnstr.)'/
1075 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1076 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1077 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1078 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1079 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1080 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1081 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1082 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1083 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1084 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1085 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1086 & 'ETOT= ',1pE16.6,' (total)')
1088 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1089 & estr,wbond,ebe,wang,
1090 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1092 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1093 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1094 & ebr*nss,Uconst,etot
1095 10 format (/'Virtual-chain energies:'//
1096 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1097 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1098 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1099 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1100 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1101 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1102 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1103 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1104 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1105 & ' (SS bridges & dist. cnstr.)'/
1106 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1107 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1108 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1109 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1110 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1111 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1112 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1113 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1114 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1115 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1116 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1117 & 'ETOT= ',1pE16.6,' (total)')
1121 C-----------------------------------------------------------------------
1122 subroutine elj(evdw,evdw_p,evdw_m)
1124 C This subroutine calculates the interaction energy of nonbonded side chains
1125 C assuming the LJ potential of interaction.
1127 implicit real*8 (a-h,o-z)
1128 include 'DIMENSIONS'
1129 parameter (accur=1.0d-10)
1130 include 'COMMON.GEO'
1131 include 'COMMON.VAR'
1132 include 'COMMON.LOCAL'
1133 include 'COMMON.CHAIN'
1134 include 'COMMON.DERIV'
1135 include 'COMMON.INTERACT'
1136 include 'COMMON.TORSION'
1137 include 'COMMON.SBRIDGE'
1138 include 'COMMON.NAMES'
1139 include 'COMMON.IOUNITS'
1140 include 'COMMON.CONTACTS'
1142 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1144 do i=iatsc_s,iatsc_e
1153 C Calculate SC interaction energy.
1155 do iint=1,nint_gr(i)
1156 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1157 cd & 'iend=',iend(i,iint)
1158 do j=istart(i,iint),iend(i,iint)
1163 C Change 12/1/95 to calculate four-body interactions
1164 rij=xj*xj+yj*yj+zj*zj
1166 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1167 eps0ij=eps(itypi,itypj)
1169 e1=fac*fac*aa(itypi,itypj)
1170 e2=fac*bb(itypi,itypj)
1172 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1173 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1174 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1175 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1176 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1177 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1179 if (bb(itypi,itypj).gt.0) then
1180 evdw_p=evdw_p+evdwij
1182 evdw_m=evdw_m+evdwij
1188 C Calculate the components of the gradient in DC and X
1190 fac=-rrij*(e1+evdwij)
1195 if (bb(itypi,itypj).gt.0.0d0) then
1197 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1198 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1199 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1200 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1204 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1205 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1206 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1207 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1212 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1213 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1214 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1215 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1220 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1224 C 12/1/95, revised on 5/20/97
1226 C Calculate the contact function. The ith column of the array JCONT will
1227 C contain the numbers of atoms that make contacts with the atom I (of numbers
1228 C greater than I). The arrays FACONT and GACONT will contain the values of
1229 C the contact function and its derivative.
1231 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1232 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1233 C Uncomment next line, if the correlation interactions are contact function only
1234 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1236 sigij=sigma(itypi,itypj)
1237 r0ij=rs0(itypi,itypj)
1239 C Check whether the SC's are not too far to make a contact.
1242 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1243 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1245 if (fcont.gt.0.0D0) then
1246 C If the SC-SC distance if close to sigma, apply spline.
1247 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1248 cAdam & fcont1,fprimcont1)
1249 cAdam fcont1=1.0d0-fcont1
1250 cAdam if (fcont1.gt.0.0d0) then
1251 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1252 cAdam fcont=fcont*fcont1
1254 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1255 cga eps0ij=1.0d0/dsqrt(eps0ij)
1257 cga gg(k)=gg(k)*eps0ij
1259 cga eps0ij=-evdwij*eps0ij
1260 C Uncomment for AL's type of SC correlation interactions.
1261 cadam eps0ij=-evdwij
1262 num_conti=num_conti+1
1263 jcont(num_conti,i)=j
1264 facont(num_conti,i)=fcont*eps0ij
1265 fprimcont=eps0ij*fprimcont/rij
1267 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1268 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1269 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1270 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1271 gacont(1,num_conti,i)=-fprimcont*xj
1272 gacont(2,num_conti,i)=-fprimcont*yj
1273 gacont(3,num_conti,i)=-fprimcont*zj
1274 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1275 cd write (iout,'(2i3,3f10.5)')
1276 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1282 num_cont(i)=num_conti
1286 gvdwc(j,i)=expon*gvdwc(j,i)
1287 gvdwx(j,i)=expon*gvdwx(j,i)
1290 C******************************************************************************
1294 C To save time, the factor of EXPON has been extracted from ALL components
1295 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1298 C******************************************************************************
1301 C-----------------------------------------------------------------------------
1302 subroutine eljk(evdw,evdw_p,evdw_m)
1304 C This subroutine calculates the interaction energy of nonbonded side chains
1305 C assuming the LJK potential of interaction.
1307 implicit real*8 (a-h,o-z)
1308 include 'DIMENSIONS'
1309 include 'COMMON.GEO'
1310 include 'COMMON.VAR'
1311 include 'COMMON.LOCAL'
1312 include 'COMMON.CHAIN'
1313 include 'COMMON.DERIV'
1314 include 'COMMON.INTERACT'
1315 include 'COMMON.IOUNITS'
1316 include 'COMMON.NAMES'
1319 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1321 do i=iatsc_s,iatsc_e
1328 C Calculate SC interaction energy.
1330 do iint=1,nint_gr(i)
1331 do j=istart(i,iint),iend(i,iint)
1336 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1337 fac_augm=rrij**expon
1338 e_augm=augm(itypi,itypj)*fac_augm
1339 r_inv_ij=dsqrt(rrij)
1341 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1342 fac=r_shift_inv**expon
1343 e1=fac*fac*aa(itypi,itypj)
1344 e2=fac*bb(itypi,itypj)
1346 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1347 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1348 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1349 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1350 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1351 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1352 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1354 if (bb(itypi,itypj).gt.0) then
1355 evdw_p=evdw_p+evdwij
1357 evdw_m=evdw_m+evdwij
1363 C Calculate the components of the gradient in DC and X
1365 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1370 if (bb(itypi,itypj).gt.0.0d0) then
1372 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1373 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1374 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1375 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1379 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1380 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1381 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1382 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1387 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1388 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1389 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1390 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1395 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1403 gvdwc(j,i)=expon*gvdwc(j,i)
1404 gvdwx(j,i)=expon*gvdwx(j,i)
1409 C-----------------------------------------------------------------------------
1410 subroutine ebp(evdw,evdw_p,evdw_m)
1412 C This subroutine calculates the interaction energy of nonbonded side chains
1413 C assuming the Berne-Pechukas potential of interaction.
1415 implicit real*8 (a-h,o-z)
1416 include 'DIMENSIONS'
1417 include 'COMMON.GEO'
1418 include 'COMMON.VAR'
1419 include 'COMMON.LOCAL'
1420 include 'COMMON.CHAIN'
1421 include 'COMMON.DERIV'
1422 include 'COMMON.NAMES'
1423 include 'COMMON.INTERACT'
1424 include 'COMMON.IOUNITS'
1425 include 'COMMON.CALC'
1426 common /srutu/ icall
1427 c double precision rrsave(maxdim)
1430 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1432 c if (icall.eq.0) then
1438 do i=iatsc_s,iatsc_e
1444 dxi=dc_norm(1,nres+i)
1445 dyi=dc_norm(2,nres+i)
1446 dzi=dc_norm(3,nres+i)
1447 c dsci_inv=dsc_inv(itypi)
1448 dsci_inv=vbld_inv(i+nres)
1450 C Calculate SC interaction energy.
1452 do iint=1,nint_gr(i)
1453 do j=istart(i,iint),iend(i,iint)
1456 c dscj_inv=dsc_inv(itypj)
1457 dscj_inv=vbld_inv(j+nres)
1458 chi1=chi(itypi,itypj)
1459 chi2=chi(itypj,itypi)
1466 alf12=0.5D0*(alf1+alf2)
1467 C For diagnostics only!!!
1480 dxj=dc_norm(1,nres+j)
1481 dyj=dc_norm(2,nres+j)
1482 dzj=dc_norm(3,nres+j)
1483 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1484 cd if (icall.eq.0) then
1490 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1492 C Calculate whole angle-dependent part of epsilon and contributions
1493 C to its derivatives
1494 fac=(rrij*sigsq)**expon2
1495 e1=fac*fac*aa(itypi,itypj)
1496 e2=fac*bb(itypi,itypj)
1497 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1498 eps2der=evdwij*eps3rt
1499 eps3der=evdwij*eps2rt
1500 evdwij=evdwij*eps2rt*eps3rt
1502 if (bb(itypi,itypj).gt.0) then
1503 evdw_p=evdw_p+evdwij
1505 evdw_m=evdw_m+evdwij
1511 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1512 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1513 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1514 cd & restyp(itypi),i,restyp(itypj),j,
1515 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1516 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1517 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1520 C Calculate gradient components.
1521 e1=e1*eps1*eps2rt**2*eps3rt**2
1522 fac=-expon*(e1+evdwij)
1525 C Calculate radial part of the gradient
1529 C Calculate the angular part of the gradient and sum add the contributions
1530 C to the appropriate components of the Cartesian gradient.
1532 if (bb(itypi,itypj).gt.0) then
1546 C-----------------------------------------------------------------------------
1547 subroutine egb(evdw,evdw_p,evdw_m)
1549 C This subroutine calculates the interaction energy of nonbonded side chains
1550 C assuming the Gay-Berne potential of interaction.
1552 implicit real*8 (a-h,o-z)
1553 include 'DIMENSIONS'
1554 include 'COMMON.GEO'
1555 include 'COMMON.VAR'
1556 include 'COMMON.LOCAL'
1557 include 'COMMON.CHAIN'
1558 include 'COMMON.DERIV'
1559 include 'COMMON.NAMES'
1560 include 'COMMON.INTERACT'
1561 include 'COMMON.IOUNITS'
1562 include 'COMMON.CALC'
1563 include 'COMMON.CONTROL'
1564 include 'COMMON.SBRIDGE'
1567 ccccc energy_dec=.false.
1568 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1573 c if (icall.eq.0) lprn=.false.
1575 do i=iatsc_s,iatsc_e
1581 dxi=dc_norm(1,nres+i)
1582 dyi=dc_norm(2,nres+i)
1583 dzi=dc_norm(3,nres+i)
1584 c dsci_inv=dsc_inv(itypi)
1585 dsci_inv=vbld_inv(i+nres)
1586 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1587 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1589 C Calculate SC interaction energy.
1591 do iint=1,nint_gr(i)
1592 do j=istart(i,iint),iend(i,iint)
1593 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1594 call dyn_ssbond_ene(i,j,evdwij)
1599 c dscj_inv=dsc_inv(itypj)
1600 dscj_inv=vbld_inv(j+nres)
1601 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1602 c & 1.0d0/vbld(j+nres)
1603 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1604 sig0ij=sigma(itypi,itypj)
1605 chi1=chi(itypi,itypj)
1606 chi2=chi(itypj,itypi)
1613 alf12=0.5D0*(alf1+alf2)
1614 C For diagnostics only!!!
1627 dxj=dc_norm(1,nres+j)
1628 dyj=dc_norm(2,nres+j)
1629 dzj=dc_norm(3,nres+j)
1630 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1631 c write (iout,*) "j",j," dc_norm",
1632 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1633 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1635 C Calculate angle-dependent terms of energy and contributions to their
1639 sig=sig0ij*dsqrt(sigsq)
1640 rij_shift=1.0D0/rij-sig+sig0ij
1641 c for diagnostics; uncomment
1642 c rij_shift=1.2*sig0ij
1643 C I hate to put IF's in the loops, but here don't have another choice!!!!
1644 if (rij_shift.le.0.0D0) then
1646 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1647 cd & restyp(itypi),i,restyp(itypj),j,
1648 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1652 c---------------------------------------------------------------
1653 rij_shift=1.0D0/rij_shift
1654 fac=rij_shift**expon
1655 e1=fac*fac*aa(itypi,itypj)
1656 e2=fac*bb(itypi,itypj)
1657 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1658 eps2der=evdwij*eps3rt
1659 eps3der=evdwij*eps2rt
1660 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1661 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1662 evdwij=evdwij*eps2rt*eps3rt
1664 if (bb(itypi,itypj).gt.0) then
1665 evdw_p=evdw_p+evdwij
1667 evdw_m=evdw_m+evdwij
1673 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1674 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1675 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1676 & restyp(itypi),i,restyp(itypj),j,
1677 & epsi,sigm,chi1,chi2,chip1,chip2,
1678 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1679 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1683 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1686 C Calculate gradient components.
1687 e1=e1*eps1*eps2rt**2*eps3rt**2
1688 fac=-expon*(e1+evdwij)*rij_shift
1692 C Calculate the radial part of the gradient
1696 C Calculate angular part of the gradient.
1698 if (bb(itypi,itypj).gt.0) then
1710 c write (iout,*) "Number of loop steps in EGB:",ind
1711 cccc energy_dec=.false.
1714 C-----------------------------------------------------------------------------
1715 subroutine egbv(evdw,evdw_p,evdw_m)
1717 C This subroutine calculates the interaction energy of nonbonded side chains
1718 C assuming the Gay-Berne-Vorobjev potential of interaction.
1720 implicit real*8 (a-h,o-z)
1721 include 'DIMENSIONS'
1722 include 'COMMON.GEO'
1723 include 'COMMON.VAR'
1724 include 'COMMON.LOCAL'
1725 include 'COMMON.CHAIN'
1726 include 'COMMON.DERIV'
1727 include 'COMMON.NAMES'
1728 include 'COMMON.INTERACT'
1729 include 'COMMON.IOUNITS'
1730 include 'COMMON.CALC'
1731 common /srutu/ icall
1734 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1737 c if (icall.eq.0) lprn=.true.
1739 do i=iatsc_s,iatsc_e
1745 dxi=dc_norm(1,nres+i)
1746 dyi=dc_norm(2,nres+i)
1747 dzi=dc_norm(3,nres+i)
1748 c dsci_inv=dsc_inv(itypi)
1749 dsci_inv=vbld_inv(i+nres)
1751 C Calculate SC interaction energy.
1753 do iint=1,nint_gr(i)
1754 do j=istart(i,iint),iend(i,iint)
1757 c dscj_inv=dsc_inv(itypj)
1758 dscj_inv=vbld_inv(j+nres)
1759 sig0ij=sigma(itypi,itypj)
1760 r0ij=r0(itypi,itypj)
1761 chi1=chi(itypi,itypj)
1762 chi2=chi(itypj,itypi)
1769 alf12=0.5D0*(alf1+alf2)
1770 C For diagnostics only!!!
1783 dxj=dc_norm(1,nres+j)
1784 dyj=dc_norm(2,nres+j)
1785 dzj=dc_norm(3,nres+j)
1786 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1788 C Calculate angle-dependent terms of energy and contributions to their
1792 sig=sig0ij*dsqrt(sigsq)
1793 rij_shift=1.0D0/rij-sig+r0ij
1794 C I hate to put IF's in the loops, but here don't have another choice!!!!
1795 if (rij_shift.le.0.0D0) then
1800 c---------------------------------------------------------------
1801 rij_shift=1.0D0/rij_shift
1802 fac=rij_shift**expon
1803 e1=fac*fac*aa(itypi,itypj)
1804 e2=fac*bb(itypi,itypj)
1805 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1806 eps2der=evdwij*eps3rt
1807 eps3der=evdwij*eps2rt
1808 fac_augm=rrij**expon
1809 e_augm=augm(itypi,itypj)*fac_augm
1810 evdwij=evdwij*eps2rt*eps3rt
1812 if (bb(itypi,itypj).gt.0) then
1813 evdw_p=evdw_p+evdwij+e_augm
1815 evdw_m=evdw_m+evdwij+e_augm
1818 evdw=evdw+evdwij+e_augm
1821 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1822 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1823 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1824 & restyp(itypi),i,restyp(itypj),j,
1825 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1826 & chi1,chi2,chip1,chip2,
1827 & eps1,eps2rt**2,eps3rt**2,
1828 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1831 C Calculate gradient components.
1832 e1=e1*eps1*eps2rt**2*eps3rt**2
1833 fac=-expon*(e1+evdwij)*rij_shift
1835 fac=rij*fac-2*expon*rrij*e_augm
1836 C Calculate the radial part of the gradient
1840 C Calculate angular part of the gradient.
1842 if (bb(itypi,itypj).gt.0) then
1854 C-----------------------------------------------------------------------------
1855 subroutine sc_angular
1856 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1857 C om12. Called by ebp, egb, and egbv.
1859 include 'COMMON.CALC'
1860 include 'COMMON.IOUNITS'
1864 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1865 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1866 om12=dxi*dxj+dyi*dyj+dzi*dzj
1868 C Calculate eps1(om12) and its derivative in om12
1869 faceps1=1.0D0-om12*chiom12
1870 faceps1_inv=1.0D0/faceps1
1871 eps1=dsqrt(faceps1_inv)
1872 C Following variable is eps1*deps1/dom12
1873 eps1_om12=faceps1_inv*chiom12
1878 c write (iout,*) "om12",om12," eps1",eps1
1879 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1884 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1885 sigsq=1.0D0-facsig*faceps1_inv
1886 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1887 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1888 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1894 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1895 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1897 C Calculate eps2 and its derivatives in om1, om2, and om12.
1900 chipom12=chip12*om12
1901 facp=1.0D0-om12*chipom12
1903 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1904 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1905 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1906 C Following variable is the square root of eps2
1907 eps2rt=1.0D0-facp1*facp_inv
1908 C Following three variables are the derivatives of the square root of eps
1909 C in om1, om2, and om12.
1910 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1911 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1912 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1913 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1914 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1915 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1916 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1917 c & " eps2rt_om12",eps2rt_om12
1918 C Calculate whole angle-dependent part of epsilon and contributions
1919 C to its derivatives
1923 C----------------------------------------------------------------------------
1924 subroutine sc_grad_T
1925 implicit real*8 (a-h,o-z)
1926 include 'DIMENSIONS'
1927 include 'COMMON.CHAIN'
1928 include 'COMMON.DERIV'
1929 include 'COMMON.CALC'
1930 include 'COMMON.IOUNITS'
1931 double precision dcosom1(3),dcosom2(3)
1932 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1933 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1934 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1935 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1939 c eom12=evdwij*eps1_om12
1941 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1942 c & " sigder",sigder
1943 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1944 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1946 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1947 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1950 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1952 c write (iout,*) "gg",(gg(k),k=1,3)
1954 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1955 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1956 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1957 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1958 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1959 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1960 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1961 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1962 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1963 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1966 C Calculate the components of the gradient in DC and X
1970 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1974 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1975 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1980 C----------------------------------------------------------------------------
1982 implicit real*8 (a-h,o-z)
1983 include 'DIMENSIONS'
1984 include 'COMMON.CHAIN'
1985 include 'COMMON.DERIV'
1986 include 'COMMON.CALC'
1987 include 'COMMON.IOUNITS'
1988 double precision dcosom1(3),dcosom2(3)
1989 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1990 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1991 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1992 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1996 c eom12=evdwij*eps1_om12
1998 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1999 c & " sigder",sigder
2000 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2001 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2003 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2004 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2007 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2009 c write (iout,*) "gg",(gg(k),k=1,3)
2011 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2012 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2013 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2014 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2015 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2016 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2017 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2018 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2019 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2020 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2023 C Calculate the components of the gradient in DC and X
2027 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2031 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2032 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2036 C-----------------------------------------------------------------------
2037 subroutine e_softsphere(evdw)
2039 C This subroutine calculates the interaction energy of nonbonded side chains
2040 C assuming the LJ potential of interaction.
2042 implicit real*8 (a-h,o-z)
2043 include 'DIMENSIONS'
2044 parameter (accur=1.0d-10)
2045 include 'COMMON.GEO'
2046 include 'COMMON.VAR'
2047 include 'COMMON.LOCAL'
2048 include 'COMMON.CHAIN'
2049 include 'COMMON.DERIV'
2050 include 'COMMON.INTERACT'
2051 include 'COMMON.TORSION'
2052 include 'COMMON.SBRIDGE'
2053 include 'COMMON.NAMES'
2054 include 'COMMON.IOUNITS'
2055 include 'COMMON.CONTACTS'
2057 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2059 do i=iatsc_s,iatsc_e
2066 C Calculate SC interaction energy.
2068 do iint=1,nint_gr(i)
2069 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2070 cd & 'iend=',iend(i,iint)
2071 do j=istart(i,iint),iend(i,iint)
2076 rij=xj*xj+yj*yj+zj*zj
2077 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2078 r0ij=r0(itypi,itypj)
2080 c print *,i,j,r0ij,dsqrt(rij)
2081 if (rij.lt.r0ijsq) then
2082 evdwij=0.25d0*(rij-r0ijsq)**2
2090 C Calculate the components of the gradient in DC and X
2096 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2097 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2098 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2099 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2103 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2111 C--------------------------------------------------------------------------
2112 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2115 C Soft-sphere potential of p-p interaction
2117 implicit real*8 (a-h,o-z)
2118 include 'DIMENSIONS'
2119 include 'COMMON.CONTROL'
2120 include 'COMMON.IOUNITS'
2121 include 'COMMON.GEO'
2122 include 'COMMON.VAR'
2123 include 'COMMON.LOCAL'
2124 include 'COMMON.CHAIN'
2125 include 'COMMON.DERIV'
2126 include 'COMMON.INTERACT'
2127 include 'COMMON.CONTACTS'
2128 include 'COMMON.TORSION'
2129 include 'COMMON.VECTORS'
2130 include 'COMMON.FFIELD'
2132 cd write(iout,*) 'In EELEC_soft_sphere'
2139 do i=iatel_s,iatel_e
2143 xmedi=c(1,i)+0.5d0*dxi
2144 ymedi=c(2,i)+0.5d0*dyi
2145 zmedi=c(3,i)+0.5d0*dzi
2147 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2148 do j=ielstart(i),ielend(i)
2152 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2153 r0ij=rpp(iteli,itelj)
2158 xj=c(1,j)+0.5D0*dxj-xmedi
2159 yj=c(2,j)+0.5D0*dyj-ymedi
2160 zj=c(3,j)+0.5D0*dzj-zmedi
2161 rij=xj*xj+yj*yj+zj*zj
2162 if (rij.lt.r0ijsq) then
2163 evdw1ij=0.25d0*(rij-r0ijsq)**2
2171 C Calculate contributions to the Cartesian gradient.
2177 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2178 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2181 * Loop over residues i+1 thru j-1.
2185 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2190 cgrad do i=nnt,nct-1
2192 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2194 cgrad do j=i+1,nct-1
2196 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2202 c------------------------------------------------------------------------------
2203 subroutine vec_and_deriv
2204 implicit real*8 (a-h,o-z)
2205 include 'DIMENSIONS'
2209 include 'COMMON.IOUNITS'
2210 include 'COMMON.GEO'
2211 include 'COMMON.VAR'
2212 include 'COMMON.LOCAL'
2213 include 'COMMON.CHAIN'
2214 include 'COMMON.VECTORS'
2215 include 'COMMON.SETUP'
2216 include 'COMMON.TIME1'
2217 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2218 C Compute the local reference systems. For reference system (i), the
2219 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2220 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2222 do i=ivec_start,ivec_end
2226 if (i.eq.nres-1) then
2227 C Case of the last full residue
2228 C Compute the Z-axis
2229 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2230 costh=dcos(pi-theta(nres))
2231 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2235 C Compute the derivatives of uz
2237 uzder(2,1,1)=-dc_norm(3,i-1)
2238 uzder(3,1,1)= dc_norm(2,i-1)
2239 uzder(1,2,1)= dc_norm(3,i-1)
2241 uzder(3,2,1)=-dc_norm(1,i-1)
2242 uzder(1,3,1)=-dc_norm(2,i-1)
2243 uzder(2,3,1)= dc_norm(1,i-1)
2246 uzder(2,1,2)= dc_norm(3,i)
2247 uzder(3,1,2)=-dc_norm(2,i)
2248 uzder(1,2,2)=-dc_norm(3,i)
2250 uzder(3,2,2)= dc_norm(1,i)
2251 uzder(1,3,2)= dc_norm(2,i)
2252 uzder(2,3,2)=-dc_norm(1,i)
2254 C Compute the Y-axis
2257 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2259 C Compute the derivatives of uy
2262 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2263 & -dc_norm(k,i)*dc_norm(j,i-1)
2264 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2266 uyder(j,j,1)=uyder(j,j,1)-costh
2267 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2272 uygrad(l,k,j,i)=uyder(l,k,j)
2273 uzgrad(l,k,j,i)=uzder(l,k,j)
2277 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2278 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2279 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2280 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2283 C Compute the Z-axis
2284 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2285 costh=dcos(pi-theta(i+2))
2286 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2290 C Compute the derivatives of uz
2292 uzder(2,1,1)=-dc_norm(3,i+1)
2293 uzder(3,1,1)= dc_norm(2,i+1)
2294 uzder(1,2,1)= dc_norm(3,i+1)
2296 uzder(3,2,1)=-dc_norm(1,i+1)
2297 uzder(1,3,1)=-dc_norm(2,i+1)
2298 uzder(2,3,1)= dc_norm(1,i+1)
2301 uzder(2,1,2)= dc_norm(3,i)
2302 uzder(3,1,2)=-dc_norm(2,i)
2303 uzder(1,2,2)=-dc_norm(3,i)
2305 uzder(3,2,2)= dc_norm(1,i)
2306 uzder(1,3,2)= dc_norm(2,i)
2307 uzder(2,3,2)=-dc_norm(1,i)
2309 C Compute the Y-axis
2312 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2314 C Compute the derivatives of uy
2317 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2318 & -dc_norm(k,i)*dc_norm(j,i+1)
2319 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2321 uyder(j,j,1)=uyder(j,j,1)-costh
2322 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2327 uygrad(l,k,j,i)=uyder(l,k,j)
2328 uzgrad(l,k,j,i)=uzder(l,k,j)
2332 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2333 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2334 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2335 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2339 vbld_inv_temp(1)=vbld_inv(i+1)
2340 if (i.lt.nres-1) then
2341 vbld_inv_temp(2)=vbld_inv(i+2)
2343 vbld_inv_temp(2)=vbld_inv(i)
2348 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2349 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2354 #if defined(PARVEC) && defined(MPI)
2355 if (nfgtasks1.gt.1) then
2357 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2358 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2359 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2360 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2361 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2363 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2364 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2366 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2367 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2368 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2369 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2370 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2371 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2372 time_gather=time_gather+MPI_Wtime()-time00
2374 c if (fg_rank.eq.0) then
2375 c write (iout,*) "Arrays UY and UZ"
2377 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2384 C-----------------------------------------------------------------------------
2385 subroutine check_vecgrad
2386 implicit real*8 (a-h,o-z)
2387 include 'DIMENSIONS'
2388 include 'COMMON.IOUNITS'
2389 include 'COMMON.GEO'
2390 include 'COMMON.VAR'
2391 include 'COMMON.LOCAL'
2392 include 'COMMON.CHAIN'
2393 include 'COMMON.VECTORS'
2394 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2395 dimension uyt(3,maxres),uzt(3,maxres)
2396 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2397 double precision delta /1.0d-7/
2400 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2401 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2402 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2403 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2404 cd & (dc_norm(if90,i),if90=1,3)
2405 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2406 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2407 cd write(iout,'(a)')
2413 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2414 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2427 cd write (iout,*) 'i=',i
2429 erij(k)=dc_norm(k,i)
2433 dc_norm(k,i)=erij(k)
2435 dc_norm(j,i)=dc_norm(j,i)+delta
2436 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2438 c dc_norm(k,i)=dc_norm(k,i)/fac
2440 c write (iout,*) (dc_norm(k,i),k=1,3)
2441 c write (iout,*) (erij(k),k=1,3)
2444 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2445 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2446 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2447 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2449 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2450 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2451 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2454 dc_norm(k,i)=erij(k)
2457 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2458 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2459 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2460 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2461 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2462 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2463 cd write (iout,'(a)')
2468 C--------------------------------------------------------------------------
2469 subroutine set_matrices
2470 implicit real*8 (a-h,o-z)
2471 include 'DIMENSIONS'
2474 include "COMMON.SETUP"
2476 integer status(MPI_STATUS_SIZE)
2478 include 'COMMON.IOUNITS'
2479 include 'COMMON.GEO'
2480 include 'COMMON.VAR'
2481 include 'COMMON.LOCAL'
2482 include 'COMMON.CHAIN'
2483 include 'COMMON.DERIV'
2484 include 'COMMON.INTERACT'
2485 include 'COMMON.CONTACTS'
2486 include 'COMMON.TORSION'
2487 include 'COMMON.VECTORS'
2488 include 'COMMON.FFIELD'
2489 double precision auxvec(2),auxmat(2,2)
2491 C Compute the virtual-bond-torsional-angle dependent quantities needed
2492 C to calculate the el-loc multibody terms of various order.
2495 do i=ivec_start+2,ivec_end+2
2499 if (i .lt. nres+1) then
2536 if (i .gt. 3 .and. i .lt. nres+1) then
2537 obrot_der(1,i-2)=-sin1
2538 obrot_der(2,i-2)= cos1
2539 Ugder(1,1,i-2)= sin1
2540 Ugder(1,2,i-2)=-cos1
2541 Ugder(2,1,i-2)=-cos1
2542 Ugder(2,2,i-2)=-sin1
2545 obrot2_der(1,i-2)=-dwasin2
2546 obrot2_der(2,i-2)= dwacos2
2547 Ug2der(1,1,i-2)= dwasin2
2548 Ug2der(1,2,i-2)=-dwacos2
2549 Ug2der(2,1,i-2)=-dwacos2
2550 Ug2der(2,2,i-2)=-dwasin2
2552 obrot_der(1,i-2)=0.0d0
2553 obrot_der(2,i-2)=0.0d0
2554 Ugder(1,1,i-2)=0.0d0
2555 Ugder(1,2,i-2)=0.0d0
2556 Ugder(2,1,i-2)=0.0d0
2557 Ugder(2,2,i-2)=0.0d0
2558 obrot2_der(1,i-2)=0.0d0
2559 obrot2_der(2,i-2)=0.0d0
2560 Ug2der(1,1,i-2)=0.0d0
2561 Ug2der(1,2,i-2)=0.0d0
2562 Ug2der(2,1,i-2)=0.0d0
2563 Ug2der(2,2,i-2)=0.0d0
2565 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2566 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2567 iti = itortyp(itype(i-2))
2571 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2572 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2573 iti1 = itortyp(itype(i-1))
2577 cd write (iout,*) '*******i',i,' iti1',iti
2578 cd write (iout,*) 'b1',b1(:,iti)
2579 cd write (iout,*) 'b2',b2(:,iti)
2580 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2581 c if (i .gt. iatel_s+2) then
2582 if (i .gt. nnt+2) then
2583 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2584 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2585 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2587 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2588 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2589 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2590 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2591 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2602 DtUg2(l,k,i-2)=0.0d0
2606 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2607 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2609 muder(k,i-2)=Ub2der(k,i-2)
2611 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2612 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2613 iti1 = itortyp(itype(i-1))
2618 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2620 cd write (iout,*) 'mu ',mu(:,i-2)
2621 cd write (iout,*) 'mu1',mu1(:,i-2)
2622 cd write (iout,*) 'mu2',mu2(:,i-2)
2623 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2625 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2626 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2627 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2628 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2629 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2630 C Vectors and matrices dependent on a single virtual-bond dihedral.
2631 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2632 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2633 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2634 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2635 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2636 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2637 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2638 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2639 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2642 C Matrices dependent on two consecutive virtual-bond dihedrals.
2643 C The order of matrices is from left to right.
2644 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2646 c do i=max0(ivec_start,2),ivec_end
2648 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2649 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2650 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2651 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2652 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2653 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2654 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2655 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2658 #if defined(MPI) && defined(PARMAT)
2660 c if (fg_rank.eq.0) then
2661 write (iout,*) "Arrays UG and UGDER before GATHER"
2663 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2664 & ((ug(l,k,i),l=1,2),k=1,2),
2665 & ((ugder(l,k,i),l=1,2),k=1,2)
2667 write (iout,*) "Arrays UG2 and UG2DER"
2669 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2670 & ((ug2(l,k,i),l=1,2),k=1,2),
2671 & ((ug2der(l,k,i),l=1,2),k=1,2)
2673 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2675 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2676 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2677 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2679 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2681 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2682 & costab(i),sintab(i),costab2(i),sintab2(i)
2684 write (iout,*) "Array MUDER"
2686 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2690 if (nfgtasks.gt.1) then
2692 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2693 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2694 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2696 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2697 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2699 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2700 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2702 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2703 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2705 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2706 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2708 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2709 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2711 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2712 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2714 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2715 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2716 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2717 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2718 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2719 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2720 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2721 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2722 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2723 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2724 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2725 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2726 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2728 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2731 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2734 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2735 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2737 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2738 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2740 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2741 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2743 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2744 & ivec_count(fg_rank1),
2745 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2747 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2748 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2750 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2751 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2753 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2754 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2756 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2757 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2759 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2760 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2762 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2763 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2765 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2766 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2768 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2769 & ivec_count(fg_rank1),
2770 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2772 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2773 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2775 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2776 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2778 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2779 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2781 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2782 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2784 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2785 & ivec_count(fg_rank1),
2786 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2788 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2789 & ivec_count(fg_rank1),
2790 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2792 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2793 & ivec_count(fg_rank1),
2794 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2795 & MPI_MAT2,FG_COMM1,IERR)
2796 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2797 & ivec_count(fg_rank1),
2798 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2799 & MPI_MAT2,FG_COMM1,IERR)
2802 c Passes matrix info through the ring
2805 if (irecv.lt.0) irecv=nfgtasks1-1
2808 if (inext.ge.nfgtasks1) inext=0
2810 c write (iout,*) "isend",isend," irecv",irecv
2812 lensend=lentyp(isend)
2813 lenrecv=lentyp(irecv)
2814 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2815 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2816 c & MPI_ROTAT1(lensend),inext,2200+isend,
2817 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2818 c & iprev,2200+irecv,FG_COMM,status,IERR)
2819 c write (iout,*) "Gather ROTAT1"
2821 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2822 c & MPI_ROTAT2(lensend),inext,3300+isend,
2823 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2824 c & iprev,3300+irecv,FG_COMM,status,IERR)
2825 c write (iout,*) "Gather ROTAT2"
2827 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2828 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2829 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2830 & iprev,4400+irecv,FG_COMM,status,IERR)
2831 c write (iout,*) "Gather ROTAT_OLD"
2833 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2834 & MPI_PRECOMP11(lensend),inext,5500+isend,
2835 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2836 & iprev,5500+irecv,FG_COMM,status,IERR)
2837 c write (iout,*) "Gather PRECOMP11"
2839 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2840 & MPI_PRECOMP12(lensend),inext,6600+isend,
2841 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2842 & iprev,6600+irecv,FG_COMM,status,IERR)
2843 c write (iout,*) "Gather PRECOMP12"
2845 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2847 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2848 & MPI_ROTAT2(lensend),inext,7700+isend,
2849 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2850 & iprev,7700+irecv,FG_COMM,status,IERR)
2851 c write (iout,*) "Gather PRECOMP21"
2853 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2854 & MPI_PRECOMP22(lensend),inext,8800+isend,
2855 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2856 & iprev,8800+irecv,FG_COMM,status,IERR)
2857 c write (iout,*) "Gather PRECOMP22"
2859 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2860 & MPI_PRECOMP23(lensend),inext,9900+isend,
2861 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2862 & MPI_PRECOMP23(lenrecv),
2863 & iprev,9900+irecv,FG_COMM,status,IERR)
2864 c write (iout,*) "Gather PRECOMP23"
2869 if (irecv.lt.0) irecv=nfgtasks1-1
2872 time_gather=time_gather+MPI_Wtime()-time00
2875 c if (fg_rank.eq.0) then
2876 write (iout,*) "Arrays UG and UGDER"
2878 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2879 & ((ug(l,k,i),l=1,2),k=1,2),
2880 & ((ugder(l,k,i),l=1,2),k=1,2)
2882 write (iout,*) "Arrays UG2 and UG2DER"
2884 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2885 & ((ug2(l,k,i),l=1,2),k=1,2),
2886 & ((ug2der(l,k,i),l=1,2),k=1,2)
2888 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2890 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2891 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2892 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2894 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2896 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2897 & costab(i),sintab(i),costab2(i),sintab2(i)
2899 write (iout,*) "Array MUDER"
2901 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2907 cd iti = itortyp(itype(i))
2910 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2911 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2916 C--------------------------------------------------------------------------
2917 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2919 C This subroutine calculates the average interaction energy and its gradient
2920 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2921 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2922 C The potential depends both on the distance of peptide-group centers and on
2923 C the orientation of the CA-CA virtual bonds.
2925 implicit real*8 (a-h,o-z)
2929 include 'DIMENSIONS'
2930 include 'COMMON.CONTROL'
2931 include 'COMMON.SETUP'
2932 include 'COMMON.IOUNITS'
2933 include 'COMMON.GEO'
2934 include 'COMMON.VAR'
2935 include 'COMMON.LOCAL'
2936 include 'COMMON.CHAIN'
2937 include 'COMMON.DERIV'
2938 include 'COMMON.INTERACT'
2939 include 'COMMON.CONTACTS'
2940 include 'COMMON.TORSION'
2941 include 'COMMON.VECTORS'
2942 include 'COMMON.FFIELD'
2943 include 'COMMON.TIME1'
2944 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2945 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2946 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2947 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2948 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2949 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2951 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2953 double precision scal_el /1.0d0/
2955 double precision scal_el /0.5d0/
2958 C 13-go grudnia roku pamietnego...
2959 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2960 & 0.0d0,1.0d0,0.0d0,
2961 & 0.0d0,0.0d0,1.0d0/
2962 cd write(iout,*) 'In EELEC'
2964 cd write(iout,*) 'Type',i
2965 cd write(iout,*) 'B1',B1(:,i)
2966 cd write(iout,*) 'B2',B2(:,i)
2967 cd write(iout,*) 'CC',CC(:,:,i)
2968 cd write(iout,*) 'DD',DD(:,:,i)
2969 cd write(iout,*) 'EE',EE(:,:,i)
2971 cd call check_vecgrad
2973 if (icheckgrad.eq.1) then
2975 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2977 dc_norm(k,i)=dc(k,i)*fac
2979 c write (iout,*) 'i',i,' fac',fac
2982 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2983 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2984 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2985 c call vec_and_deriv
2991 time_mat=time_mat+MPI_Wtime()-time01
2995 cd write (iout,*) 'i=',i
2997 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3000 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3001 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3014 cd print '(a)','Enter EELEC'
3015 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3017 gel_loc_loc(i)=0.0d0
3022 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3024 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3026 do i=iturn3_start,iturn3_end
3030 dx_normi=dc_norm(1,i)
3031 dy_normi=dc_norm(2,i)
3032 dz_normi=dc_norm(3,i)
3033 xmedi=c(1,i)+0.5d0*dxi
3034 ymedi=c(2,i)+0.5d0*dyi
3035 zmedi=c(3,i)+0.5d0*dzi
3037 call eelecij(i,i+2,ees,evdw1,eel_loc)
3038 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3039 num_cont_hb(i)=num_conti
3041 do i=iturn4_start,iturn4_end
3045 dx_normi=dc_norm(1,i)
3046 dy_normi=dc_norm(2,i)
3047 dz_normi=dc_norm(3,i)
3048 xmedi=c(1,i)+0.5d0*dxi
3049 ymedi=c(2,i)+0.5d0*dyi
3050 zmedi=c(3,i)+0.5d0*dzi
3051 num_conti=num_cont_hb(i)
3052 call eelecij(i,i+3,ees,evdw1,eel_loc)
3053 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3054 num_cont_hb(i)=num_conti
3057 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3059 do i=iatel_s,iatel_e
3063 dx_normi=dc_norm(1,i)
3064 dy_normi=dc_norm(2,i)
3065 dz_normi=dc_norm(3,i)
3066 xmedi=c(1,i)+0.5d0*dxi
3067 ymedi=c(2,i)+0.5d0*dyi
3068 zmedi=c(3,i)+0.5d0*dzi
3069 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3070 num_conti=num_cont_hb(i)
3071 do j=ielstart(i),ielend(i)
3072 call eelecij(i,j,ees,evdw1,eel_loc)
3074 num_cont_hb(i)=num_conti
3076 c write (iout,*) "Number of loop steps in EELEC:",ind
3078 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3079 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3081 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3082 ccc eel_loc=eel_loc+eello_turn3
3083 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3086 C-------------------------------------------------------------------------------
3087 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3088 implicit real*8 (a-h,o-z)
3089 include 'DIMENSIONS'
3093 include 'COMMON.CONTROL'
3094 include 'COMMON.IOUNITS'
3095 include 'COMMON.GEO'
3096 include 'COMMON.VAR'
3097 include 'COMMON.LOCAL'
3098 include 'COMMON.CHAIN'
3099 include 'COMMON.DERIV'
3100 include 'COMMON.INTERACT'
3101 include 'COMMON.CONTACTS'
3102 include 'COMMON.TORSION'
3103 include 'COMMON.VECTORS'
3104 include 'COMMON.FFIELD'
3105 include 'COMMON.TIME1'
3106 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3107 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3108 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3109 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3110 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3111 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3113 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3115 double precision scal_el /1.0d0/
3117 double precision scal_el /0.5d0/
3120 C 13-go grudnia roku pamietnego...
3121 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3122 & 0.0d0,1.0d0,0.0d0,
3123 & 0.0d0,0.0d0,1.0d0/
3124 c time00=MPI_Wtime()
3125 cd write (iout,*) "eelecij",i,j
3129 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3130 aaa=app(iteli,itelj)
3131 bbb=bpp(iteli,itelj)
3132 ael6i=ael6(iteli,itelj)
3133 ael3i=ael3(iteli,itelj)
3137 dx_normj=dc_norm(1,j)
3138 dy_normj=dc_norm(2,j)
3139 dz_normj=dc_norm(3,j)
3140 xj=c(1,j)+0.5D0*dxj-xmedi
3141 yj=c(2,j)+0.5D0*dyj-ymedi
3142 zj=c(3,j)+0.5D0*dzj-zmedi
3143 rij=xj*xj+yj*yj+zj*zj
3149 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3150 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3151 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3152 fac=cosa-3.0D0*cosb*cosg
3154 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3155 if (j.eq.i+2) ev1=scal_el*ev1
3160 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3163 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3164 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3167 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3168 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3169 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3170 cd & xmedi,ymedi,zmedi,xj,yj,zj
3172 if (energy_dec) then
3173 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3174 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3178 C Calculate contributions to the Cartesian gradient.
3181 facvdw=-6*rrmij*(ev1+evdwij)
3182 facel=-3*rrmij*(el1+eesij)
3188 * Radial derivatives. First process both termini of the fragment (i,j)
3194 c ghalf=0.5D0*ggg(k)
3195 c gelc(k,i)=gelc(k,i)+ghalf
3196 c gelc(k,j)=gelc(k,j)+ghalf
3198 c 9/28/08 AL Gradient compotents will be summed only at the end
3200 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3201 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3204 * Loop over residues i+1 thru j-1.
3208 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3215 c ghalf=0.5D0*ggg(k)
3216 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3217 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3219 c 9/28/08 AL Gradient compotents will be summed only at the end
3221 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3222 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3225 * Loop over residues i+1 thru j-1.
3229 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3236 fac=-3*rrmij*(facvdw+facvdw+facel)
3241 * Radial derivatives. First process both termini of the fragment (i,j)
3247 c ghalf=0.5D0*ggg(k)
3248 c gelc(k,i)=gelc(k,i)+ghalf
3249 c gelc(k,j)=gelc(k,j)+ghalf
3251 c 9/28/08 AL Gradient compotents will be summed only at the end
3253 gelc_long(k,j)=gelc(k,j)+ggg(k)
3254 gelc_long(k,i)=gelc(k,i)-ggg(k)
3257 * Loop over residues i+1 thru j-1.
3261 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3264 c 9/28/08 AL Gradient compotents will be summed only at the end
3269 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3270 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3276 ecosa=2.0D0*fac3*fac1+fac4
3279 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3280 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3282 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3283 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3285 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3286 cd & (dcosg(k),k=1,3)
3288 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3291 c ghalf=0.5D0*ggg(k)
3292 c gelc(k,i)=gelc(k,i)+ghalf
3293 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3294 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3295 c gelc(k,j)=gelc(k,j)+ghalf
3296 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3297 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3301 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3306 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3307 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3309 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3310 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3311 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3312 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3314 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3315 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3316 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3318 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3319 C energy of a peptide unit is assumed in the form of a second-order
3320 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3321 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3322 C are computed for EVERY pair of non-contiguous peptide groups.
3324 if (j.lt.nres-1) then
3335 muij(kkk)=mu(k,i)*mu(l,j)
3338 cd write (iout,*) 'EELEC: i',i,' j',j
3339 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3340 cd write(iout,*) 'muij',muij
3341 ury=scalar(uy(1,i),erij)
3342 urz=scalar(uz(1,i),erij)
3343 vry=scalar(uy(1,j),erij)
3344 vrz=scalar(uz(1,j),erij)
3345 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3346 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3347 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3348 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3349 fac=dsqrt(-ael6i)*r3ij
3354 cd write (iout,'(4i5,4f10.5)')
3355 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3356 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3357 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3358 cd & uy(:,j),uz(:,j)
3359 cd write (iout,'(4f10.5)')
3360 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3361 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3362 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3363 cd write (iout,'(9f10.5/)')
3364 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3365 C Derivatives of the elements of A in virtual-bond vectors
3366 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3368 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3369 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3370 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3371 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3372 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3373 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3374 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3375 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3376 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3377 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3378 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3379 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3381 C Compute radial contributions to the gradient
3399 C Add the contributions coming from er
3402 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3403 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3404 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3405 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3408 C Derivatives in DC(i)
3409 cgrad ghalf1=0.5d0*agg(k,1)
3410 cgrad ghalf2=0.5d0*agg(k,2)
3411 cgrad ghalf3=0.5d0*agg(k,3)
3412 cgrad ghalf4=0.5d0*agg(k,4)
3413 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3414 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3415 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3416 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3417 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3418 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3419 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3420 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3421 C Derivatives in DC(i+1)
3422 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3423 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3424 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3425 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3426 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3427 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3428 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3429 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3430 C Derivatives in DC(j)
3431 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3432 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3433 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3434 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3435 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3436 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3437 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3438 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3439 C Derivatives in DC(j+1) or DC(nres-1)
3440 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3441 & -3.0d0*vryg(k,3)*ury)
3442 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3443 & -3.0d0*vrzg(k,3)*ury)
3444 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3445 & -3.0d0*vryg(k,3)*urz)
3446 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3447 & -3.0d0*vrzg(k,3)*urz)
3448 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3450 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3463 aggi(k,l)=-aggi(k,l)
3464 aggi1(k,l)=-aggi1(k,l)
3465 aggj(k,l)=-aggj(k,l)
3466 aggj1(k,l)=-aggj1(k,l)
3469 if (j.lt.nres-1) then
3475 aggi(k,l)=-aggi(k,l)
3476 aggi1(k,l)=-aggi1(k,l)
3477 aggj(k,l)=-aggj(k,l)
3478 aggj1(k,l)=-aggj1(k,l)
3489 aggi(k,l)=-aggi(k,l)
3490 aggi1(k,l)=-aggi1(k,l)
3491 aggj(k,l)=-aggj(k,l)
3492 aggj1(k,l)=-aggj1(k,l)
3497 IF (wel_loc.gt.0.0d0) THEN
3498 C Contribution to the local-electrostatic energy coming from the i-j pair
3499 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3501 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3503 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3504 & 'eelloc',i,j,eel_loc_ij
3506 eel_loc=eel_loc+eel_loc_ij
3507 C Partial derivatives in virtual-bond dihedral angles gamma
3509 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3510 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3511 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3512 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3513 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3514 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3515 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3517 ggg(l)=agg(l,1)*muij(1)+
3518 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3519 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3520 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3521 cgrad ghalf=0.5d0*ggg(l)
3522 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3523 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3527 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3530 C Remaining derivatives of eello
3532 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3533 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3534 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3535 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3536 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3537 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3538 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3539 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3542 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3543 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3544 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3545 & .and. num_conti.le.maxconts) then
3546 c write (iout,*) i,j," entered corr"
3548 C Calculate the contact function. The ith column of the array JCONT will
3549 C contain the numbers of atoms that make contacts with the atom I (of numbers
3550 C greater than I). The arrays FACONT and GACONT will contain the values of
3551 C the contact function and its derivative.
3552 c r0ij=1.02D0*rpp(iteli,itelj)
3553 c r0ij=1.11D0*rpp(iteli,itelj)
3554 r0ij=2.20D0*rpp(iteli,itelj)
3555 c r0ij=1.55D0*rpp(iteli,itelj)
3556 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3557 if (fcont.gt.0.0D0) then
3558 num_conti=num_conti+1
3559 if (num_conti.gt.maxconts) then
3560 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3561 & ' will skip next contacts for this conf.'
3563 jcont_hb(num_conti,i)=j
3564 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3565 cd & " jcont_hb",jcont_hb(num_conti,i)
3566 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3567 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3568 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3570 d_cont(num_conti,i)=rij
3571 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3572 C --- Electrostatic-interaction matrix ---
3573 a_chuj(1,1,num_conti,i)=a22
3574 a_chuj(1,2,num_conti,i)=a23
3575 a_chuj(2,1,num_conti,i)=a32
3576 a_chuj(2,2,num_conti,i)=a33
3577 C --- Gradient of rij
3579 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3586 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3587 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3588 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3589 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3590 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3595 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3596 C Calculate contact energies
3598 wij=cosa-3.0D0*cosb*cosg
3601 c fac3=dsqrt(-ael6i)/r0ij**3
3602 fac3=dsqrt(-ael6i)*r3ij
3603 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3604 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3605 if (ees0tmp.gt.0) then
3606 ees0pij=dsqrt(ees0tmp)
3610 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3611 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3612 if (ees0tmp.gt.0) then
3613 ees0mij=dsqrt(ees0tmp)
3618 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3619 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3620 C Diagnostics. Comment out or remove after debugging!
3621 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3622 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3623 c ees0m(num_conti,i)=0.0D0
3625 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3626 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3627 C Angular derivatives of the contact function
3628 ees0pij1=fac3/ees0pij
3629 ees0mij1=fac3/ees0mij
3630 fac3p=-3.0D0*fac3*rrmij
3631 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3632 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3634 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3635 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3636 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3637 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3638 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3639 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3640 ecosap=ecosa1+ecosa2
3641 ecosbp=ecosb1+ecosb2
3642 ecosgp=ecosg1+ecosg2
3643 ecosam=ecosa1-ecosa2
3644 ecosbm=ecosb1-ecosb2
3645 ecosgm=ecosg1-ecosg2
3654 facont_hb(num_conti,i)=fcont
3655 fprimcont=fprimcont/rij
3656 cd facont_hb(num_conti,i)=1.0D0
3657 C Following line is for diagnostics.
3660 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3661 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3664 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3665 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3667 gggp(1)=gggp(1)+ees0pijp*xj
3668 gggp(2)=gggp(2)+ees0pijp*yj
3669 gggp(3)=gggp(3)+ees0pijp*zj
3670 gggm(1)=gggm(1)+ees0mijp*xj
3671 gggm(2)=gggm(2)+ees0mijp*yj
3672 gggm(3)=gggm(3)+ees0mijp*zj
3673 C Derivatives due to the contact function
3674 gacont_hbr(1,num_conti,i)=fprimcont*xj
3675 gacont_hbr(2,num_conti,i)=fprimcont*yj
3676 gacont_hbr(3,num_conti,i)=fprimcont*zj
3679 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3680 c following the change of gradient-summation algorithm.
3682 cgrad ghalfp=0.5D0*gggp(k)
3683 cgrad ghalfm=0.5D0*gggm(k)
3684 gacontp_hb1(k,num_conti,i)=!ghalfp
3685 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3686 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3687 gacontp_hb2(k,num_conti,i)=!ghalfp
3688 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3689 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3690 gacontp_hb3(k,num_conti,i)=gggp(k)
3691 gacontm_hb1(k,num_conti,i)=!ghalfm
3692 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3693 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3694 gacontm_hb2(k,num_conti,i)=!ghalfm
3695 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3696 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3697 gacontm_hb3(k,num_conti,i)=gggm(k)
3699 C Diagnostics. Comment out or remove after debugging!
3701 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3702 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3703 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3704 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3705 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3706 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3709 endif ! num_conti.le.maxconts
3712 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3715 ghalf=0.5d0*agg(l,k)
3716 aggi(l,k)=aggi(l,k)+ghalf
3717 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3718 aggj(l,k)=aggj(l,k)+ghalf
3721 if (j.eq.nres-1 .and. i.lt.j-2) then
3724 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3729 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3732 C-----------------------------------------------------------------------------
3733 subroutine eturn3(i,eello_turn3)
3734 C Third- and fourth-order contributions from turns
3735 implicit real*8 (a-h,o-z)
3736 include 'DIMENSIONS'
3737 include 'COMMON.IOUNITS'
3738 include 'COMMON.GEO'
3739 include 'COMMON.VAR'
3740 include 'COMMON.LOCAL'
3741 include 'COMMON.CHAIN'
3742 include 'COMMON.DERIV'
3743 include 'COMMON.INTERACT'
3744 include 'COMMON.CONTACTS'
3745 include 'COMMON.TORSION'
3746 include 'COMMON.VECTORS'
3747 include 'COMMON.FFIELD'
3748 include 'COMMON.CONTROL'
3750 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3751 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3752 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3753 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3754 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3755 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3756 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3759 c write (iout,*) "eturn3",i,j,j1,j2
3764 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3766 C Third-order contributions
3773 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3774 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3775 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3776 call transpose2(auxmat(1,1),auxmat1(1,1))
3777 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3778 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3779 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3780 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3781 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3782 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3783 cd & ' eello_turn3_num',4*eello_turn3_num
3784 C Derivatives in gamma(i)
3785 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3786 call transpose2(auxmat2(1,1),auxmat3(1,1))
3787 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3788 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3789 C Derivatives in gamma(i+1)
3790 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3791 call transpose2(auxmat2(1,1),auxmat3(1,1))
3792 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3793 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3794 & +0.5d0*(pizda(1,1)+pizda(2,2))
3795 C Cartesian derivatives
3797 c ghalf1=0.5d0*agg(l,1)
3798 c ghalf2=0.5d0*agg(l,2)
3799 c ghalf3=0.5d0*agg(l,3)
3800 c ghalf4=0.5d0*agg(l,4)
3801 a_temp(1,1)=aggi(l,1)!+ghalf1
3802 a_temp(1,2)=aggi(l,2)!+ghalf2
3803 a_temp(2,1)=aggi(l,3)!+ghalf3
3804 a_temp(2,2)=aggi(l,4)!+ghalf4
3805 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3806 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3807 & +0.5d0*(pizda(1,1)+pizda(2,2))
3808 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3809 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3810 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3811 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3812 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3813 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3814 & +0.5d0*(pizda(1,1)+pizda(2,2))
3815 a_temp(1,1)=aggj(l,1)!+ghalf1
3816 a_temp(1,2)=aggj(l,2)!+ghalf2
3817 a_temp(2,1)=aggj(l,3)!+ghalf3
3818 a_temp(2,2)=aggj(l,4)!+ghalf4
3819 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3820 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3821 & +0.5d0*(pizda(1,1)+pizda(2,2))
3822 a_temp(1,1)=aggj1(l,1)
3823 a_temp(1,2)=aggj1(l,2)
3824 a_temp(2,1)=aggj1(l,3)
3825 a_temp(2,2)=aggj1(l,4)
3826 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3827 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3828 & +0.5d0*(pizda(1,1)+pizda(2,2))
3832 C-------------------------------------------------------------------------------
3833 subroutine eturn4(i,eello_turn4)
3834 C Third- and fourth-order contributions from turns
3835 implicit real*8 (a-h,o-z)
3836 include 'DIMENSIONS'
3837 include 'COMMON.IOUNITS'
3838 include 'COMMON.GEO'
3839 include 'COMMON.VAR'
3840 include 'COMMON.LOCAL'
3841 include 'COMMON.CHAIN'
3842 include 'COMMON.DERIV'
3843 include 'COMMON.INTERACT'
3844 include 'COMMON.CONTACTS'
3845 include 'COMMON.TORSION'
3846 include 'COMMON.VECTORS'
3847 include 'COMMON.FFIELD'
3848 include 'COMMON.CONTROL'
3850 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3851 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3852 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3853 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3854 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3855 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3856 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3859 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3861 C Fourth-order contributions
3869 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3870 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3871 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3876 iti1=itortyp(itype(i+1))
3877 iti2=itortyp(itype(i+2))
3878 iti3=itortyp(itype(i+3))
3879 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3880 call transpose2(EUg(1,1,i+1),e1t(1,1))
3881 call transpose2(Eug(1,1,i+2),e2t(1,1))
3882 call transpose2(Eug(1,1,i+3),e3t(1,1))
3883 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3884 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3885 s1=scalar2(b1(1,iti2),auxvec(1))
3886 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3887 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3888 s2=scalar2(b1(1,iti1),auxvec(1))
3889 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3890 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3891 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3892 eello_turn4=eello_turn4-(s1+s2+s3)
3893 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3894 & 'eturn4',i,j,-(s1+s2+s3)
3895 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3896 cd & ' eello_turn4_num',8*eello_turn4_num
3897 C Derivatives in gamma(i)
3898 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3899 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3900 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3901 s1=scalar2(b1(1,iti2),auxvec(1))
3902 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3903 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3904 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3905 C Derivatives in gamma(i+1)
3906 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3907 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3908 s2=scalar2(b1(1,iti1),auxvec(1))
3909 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3910 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3911 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3912 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3913 C Derivatives in gamma(i+2)
3914 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3915 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3916 s1=scalar2(b1(1,iti2),auxvec(1))
3917 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3918 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3919 s2=scalar2(b1(1,iti1),auxvec(1))
3920 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3921 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3922 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3923 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3924 C Cartesian derivatives
3925 C Derivatives of this turn contributions in DC(i+2)
3926 if (j.lt.nres-1) then
3928 a_temp(1,1)=agg(l,1)
3929 a_temp(1,2)=agg(l,2)
3930 a_temp(2,1)=agg(l,3)
3931 a_temp(2,2)=agg(l,4)
3932 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3933 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3934 s1=scalar2(b1(1,iti2),auxvec(1))
3935 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3936 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3937 s2=scalar2(b1(1,iti1),auxvec(1))
3938 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3939 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3940 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3942 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3945 C Remaining derivatives of this turn contribution
3947 a_temp(1,1)=aggi(l,1)
3948 a_temp(1,2)=aggi(l,2)
3949 a_temp(2,1)=aggi(l,3)
3950 a_temp(2,2)=aggi(l,4)
3951 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3952 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3953 s1=scalar2(b1(1,iti2),auxvec(1))
3954 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3955 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3956 s2=scalar2(b1(1,iti1),auxvec(1))
3957 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3958 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3959 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3960 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3961 a_temp(1,1)=aggi1(l,1)
3962 a_temp(1,2)=aggi1(l,2)
3963 a_temp(2,1)=aggi1(l,3)
3964 a_temp(2,2)=aggi1(l,4)
3965 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3966 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3967 s1=scalar2(b1(1,iti2),auxvec(1))
3968 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3969 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3970 s2=scalar2(b1(1,iti1),auxvec(1))
3971 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3972 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3973 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3974 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3975 a_temp(1,1)=aggj(l,1)
3976 a_temp(1,2)=aggj(l,2)
3977 a_temp(2,1)=aggj(l,3)
3978 a_temp(2,2)=aggj(l,4)
3979 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3980 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3981 s1=scalar2(b1(1,iti2),auxvec(1))
3982 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3983 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3984 s2=scalar2(b1(1,iti1),auxvec(1))
3985 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3986 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3987 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3988 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3989 a_temp(1,1)=aggj1(l,1)
3990 a_temp(1,2)=aggj1(l,2)
3991 a_temp(2,1)=aggj1(l,3)
3992 a_temp(2,2)=aggj1(l,4)
3993 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3994 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3995 s1=scalar2(b1(1,iti2),auxvec(1))
3996 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3997 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3998 s2=scalar2(b1(1,iti1),auxvec(1))
3999 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4000 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4001 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4002 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4003 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4007 C-----------------------------------------------------------------------------
4008 subroutine vecpr(u,v,w)
4009 implicit real*8(a-h,o-z)
4010 dimension u(3),v(3),w(3)
4011 w(1)=u(2)*v(3)-u(3)*v(2)
4012 w(2)=-u(1)*v(3)+u(3)*v(1)
4013 w(3)=u(1)*v(2)-u(2)*v(1)
4016 C-----------------------------------------------------------------------------
4017 subroutine unormderiv(u,ugrad,unorm,ungrad)
4018 C This subroutine computes the derivatives of a normalized vector u, given
4019 C the derivatives computed without normalization conditions, ugrad. Returns
4022 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4023 double precision vec(3)
4024 double precision scalar
4026 c write (2,*) 'ugrad',ugrad
4029 vec(i)=scalar(ugrad(1,i),u(1))
4031 c write (2,*) 'vec',vec
4034 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4037 c write (2,*) 'ungrad',ungrad
4040 C-----------------------------------------------------------------------------
4041 subroutine escp_soft_sphere(evdw2,evdw2_14)
4043 C This subroutine calculates the excluded-volume interaction energy between
4044 C peptide-group centers and side chains and its gradient in virtual-bond and
4045 C side-chain vectors.
4047 implicit real*8 (a-h,o-z)
4048 include 'DIMENSIONS'
4049 include 'COMMON.GEO'
4050 include 'COMMON.VAR'
4051 include 'COMMON.LOCAL'
4052 include 'COMMON.CHAIN'
4053 include 'COMMON.DERIV'
4054 include 'COMMON.INTERACT'
4055 include 'COMMON.FFIELD'
4056 include 'COMMON.IOUNITS'
4057 include 'COMMON.CONTROL'
4062 cd print '(a)','Enter ESCP'
4063 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4064 do i=iatscp_s,iatscp_e
4066 xi=0.5D0*(c(1,i)+c(1,i+1))
4067 yi=0.5D0*(c(2,i)+c(2,i+1))
4068 zi=0.5D0*(c(3,i)+c(3,i+1))
4070 do iint=1,nscp_gr(i)
4072 do j=iscpstart(i,iint),iscpend(i,iint)
4074 C Uncomment following three lines for SC-p interactions
4078 C Uncomment following three lines for Ca-p interactions
4082 rij=xj*xj+yj*yj+zj*zj
4085 if (rij.lt.r0ijsq) then
4086 evdwij=0.25d0*(rij-r0ijsq)**2
4094 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4099 cgrad if (j.lt.i) then
4100 cd write (iout,*) 'j<i'
4101 C Uncomment following three lines for SC-p interactions
4103 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4106 cd write (iout,*) 'j>i'
4108 cgrad ggg(k)=-ggg(k)
4109 C Uncomment following line for SC-p interactions
4110 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4114 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4116 cgrad kstart=min0(i+1,j)
4117 cgrad kend=max0(i-1,j-1)
4118 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4119 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4120 cgrad do k=kstart,kend
4122 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4126 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4127 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4135 C-----------------------------------------------------------------------------
4136 subroutine escp(evdw2,evdw2_14)
4138 C This subroutine calculates the excluded-volume interaction energy between
4139 C peptide-group centers and side chains and its gradient in virtual-bond and
4140 C side-chain vectors.
4142 implicit real*8 (a-h,o-z)
4143 include 'DIMENSIONS'
4144 include 'COMMON.GEO'
4145 include 'COMMON.VAR'
4146 include 'COMMON.LOCAL'
4147 include 'COMMON.CHAIN'
4148 include 'COMMON.DERIV'
4149 include 'COMMON.INTERACT'
4150 include 'COMMON.FFIELD'
4151 include 'COMMON.IOUNITS'
4152 include 'COMMON.CONTROL'
4156 cd print '(a)','Enter ESCP'
4157 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4158 do i=iatscp_s,iatscp_e
4160 xi=0.5D0*(c(1,i)+c(1,i+1))
4161 yi=0.5D0*(c(2,i)+c(2,i+1))
4162 zi=0.5D0*(c(3,i)+c(3,i+1))
4164 do iint=1,nscp_gr(i)
4166 do j=iscpstart(i,iint),iscpend(i,iint)
4168 C Uncomment following three lines for SC-p interactions
4172 C Uncomment following three lines for Ca-p interactions
4176 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4178 e1=fac*fac*aad(itypj,iteli)
4179 e2=fac*bad(itypj,iteli)
4180 if (iabs(j-i) .le. 2) then
4183 evdw2_14=evdw2_14+e1+e2
4187 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4188 & 'evdw2',i,j,evdwij
4190 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4192 fac=-(evdwij+e1)*rrij
4196 cgrad if (j.lt.i) then
4197 cd write (iout,*) 'j<i'
4198 C Uncomment following three lines for SC-p interactions
4200 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4203 cd write (iout,*) 'j>i'
4205 cgrad ggg(k)=-ggg(k)
4206 C Uncomment following line for SC-p interactions
4207 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4208 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4212 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4214 cgrad kstart=min0(i+1,j)
4215 cgrad kend=max0(i-1,j-1)
4216 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4217 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4218 cgrad do k=kstart,kend
4220 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4224 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4225 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4233 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4234 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4235 gradx_scp(j,i)=expon*gradx_scp(j,i)
4238 C******************************************************************************
4242 C To save time the factor EXPON has been extracted from ALL components
4243 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4246 C******************************************************************************
4249 C--------------------------------------------------------------------------
4250 subroutine edis(ehpb)
4252 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4254 implicit real*8 (a-h,o-z)
4255 include 'DIMENSIONS'
4256 include 'COMMON.SBRIDGE'
4257 include 'COMMON.CHAIN'
4258 include 'COMMON.DERIV'
4259 include 'COMMON.VAR'
4260 include 'COMMON.INTERACT'
4261 include 'COMMON.IOUNITS'
4264 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4265 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4266 if (link_end.eq.0) return
4267 do i=link_start,link_end
4268 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4269 C CA-CA distance used in regularization of structure.
4272 C iii and jjj point to the residues for which the distance is assigned.
4273 if (ii.gt.nres) then
4280 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4281 c & dhpb(i),dhpb1(i),forcon(i)
4282 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4283 C distance and angle dependent SS bond potential.
4284 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4285 call ssbond_ene(iii,jjj,eij)
4287 cd write (iout,*) "eij",eij
4288 else if (ii.gt.nres .and. jj.gt.nres) then
4289 c Restraints from contact prediction
4291 if (dhpb1(i).gt.0.0d0) then
4292 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4293 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4294 c write (iout,*) "beta nmr",
4295 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4299 C Get the force constant corresponding to this distance.
4301 C Calculate the contribution to energy.
4302 ehpb=ehpb+waga*rdis*rdis
4303 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4305 C Evaluate gradient.
4310 ggg(j)=fac*(c(j,jj)-c(j,ii))
4313 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4314 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4317 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4318 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4321 C Calculate the distance between the two points and its difference from the
4324 if (dhpb1(i).gt.0.0d0) then
4325 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4326 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4327 c write (iout,*) "alph nmr",
4328 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4331 C Get the force constant corresponding to this distance.
4333 C Calculate the contribution to energy.
4334 ehpb=ehpb+waga*rdis*rdis
4335 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4337 C Evaluate gradient.
4341 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4342 cd & ' waga=',waga,' fac=',fac
4344 ggg(j)=fac*(c(j,jj)-c(j,ii))
4346 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4347 C If this is a SC-SC distance, we need to calculate the contributions to the
4348 C Cartesian gradient in the SC vectors (ghpbx).
4351 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4352 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4355 cgrad do j=iii,jjj-1
4357 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4361 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4362 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4369 C--------------------------------------------------------------------------
4370 subroutine ssbond_ene(i,j,eij)
4372 C Calculate the distance and angle dependent SS-bond potential energy
4373 C using a free-energy function derived based on RHF/6-31G** ab initio
4374 C calculations of diethyl disulfide.
4376 C A. Liwo and U. Kozlowska, 11/24/03
4378 implicit real*8 (a-h,o-z)
4379 include 'DIMENSIONS'
4380 include 'COMMON.SBRIDGE'
4381 include 'COMMON.CHAIN'
4382 include 'COMMON.DERIV'
4383 include 'COMMON.LOCAL'
4384 include 'COMMON.INTERACT'
4385 include 'COMMON.VAR'
4386 include 'COMMON.IOUNITS'
4387 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4392 dxi=dc_norm(1,nres+i)
4393 dyi=dc_norm(2,nres+i)
4394 dzi=dc_norm(3,nres+i)
4395 c dsci_inv=dsc_inv(itypi)
4396 dsci_inv=vbld_inv(nres+i)
4398 c dscj_inv=dsc_inv(itypj)
4399 dscj_inv=vbld_inv(nres+j)
4403 dxj=dc_norm(1,nres+j)
4404 dyj=dc_norm(2,nres+j)
4405 dzj=dc_norm(3,nres+j)
4406 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4411 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4412 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4413 om12=dxi*dxj+dyi*dyj+dzi*dzj
4415 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4416 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4422 deltat12=om2-om1+2.0d0
4424 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4425 & +akct*deltad*deltat12
4426 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4427 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4428 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4429 c & " deltat12",deltat12," eij",eij
4430 ed=2*akcm*deltad+akct*deltat12
4432 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4433 eom1=-2*akth*deltat1-pom1-om2*pom2
4434 eom2= 2*akth*deltat2+pom1-om1*pom2
4437 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4438 ghpbx(k,i)=ghpbx(k,i)-ggk
4439 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4440 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4441 ghpbx(k,j)=ghpbx(k,j)+ggk
4442 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4443 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4444 ghpbc(k,i)=ghpbc(k,i)-ggk
4445 ghpbc(k,j)=ghpbc(k,j)+ggk
4448 C Calculate the components of the gradient in DC and X
4452 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4457 C--------------------------------------------------------------------------
4458 subroutine ebond(estr)
4460 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4462 implicit real*8 (a-h,o-z)
4463 include 'DIMENSIONS'
4464 include 'COMMON.LOCAL'
4465 include 'COMMON.GEO'
4466 include 'COMMON.INTERACT'
4467 include 'COMMON.DERIV'
4468 include 'COMMON.VAR'
4469 include 'COMMON.CHAIN'
4470 include 'COMMON.IOUNITS'
4471 include 'COMMON.NAMES'
4472 include 'COMMON.FFIELD'
4473 include 'COMMON.CONTROL'
4474 include 'COMMON.SETUP'
4475 double precision u(3),ud(3)
4477 do i=ibondp_start,ibondp_end
4478 diff = vbld(i)-vbldp0
4479 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4482 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4484 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4488 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4490 do i=ibond_start,ibond_end
4495 diff=vbld(i+nres)-vbldsc0(1,iti)
4496 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4497 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4498 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4500 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4504 diff=vbld(i+nres)-vbldsc0(j,iti)
4505 ud(j)=aksc(j,iti)*diff
4506 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4520 uprod2=uprod2*u(k)*u(k)
4524 usumsqder=usumsqder+ud(j)*uprod2
4526 estr=estr+uprod/usum
4528 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4536 C--------------------------------------------------------------------------
4537 subroutine ebend(etheta)
4539 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4540 C angles gamma and its derivatives in consecutive thetas and gammas.
4542 implicit real*8 (a-h,o-z)
4543 include 'DIMENSIONS'
4544 include 'COMMON.LOCAL'
4545 include 'COMMON.GEO'
4546 include 'COMMON.INTERACT'
4547 include 'COMMON.DERIV'
4548 include 'COMMON.VAR'
4549 include 'COMMON.CHAIN'
4550 include 'COMMON.IOUNITS'
4551 include 'COMMON.NAMES'
4552 include 'COMMON.FFIELD'
4553 include 'COMMON.CONTROL'
4554 common /calcthet/ term1,term2,termm,diffak,ratak,
4555 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4556 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4557 double precision y(2),z(2)
4559 c time11=dexp(-2*time)
4562 c write (*,'(a,i2)') 'EBEND ICG=',icg
4563 do i=ithet_start,ithet_end
4564 C Zero the energy function and its derivative at 0 or pi.
4565 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4570 if (phii.ne.phii) phii=150.0
4583 if (phii1.ne.phii1) phii1=150.0
4595 C Calculate the "mean" value of theta from the part of the distribution
4596 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4597 C In following comments this theta will be referred to as t_c.
4598 thet_pred_mean=0.0d0
4602 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4604 dthett=thet_pred_mean*ssd
4605 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4606 C Derivatives of the "mean" values in gamma1 and gamma2.
4607 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4608 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4609 if (theta(i).gt.pi-delta) then
4610 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4612 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4613 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4614 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4616 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4618 else if (theta(i).lt.delta) then
4619 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4620 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4621 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4623 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4624 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4627 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4630 etheta=etheta+ethetai
4631 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4633 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4634 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4635 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4637 C Ufff.... We've done all this!!!
4640 C---------------------------------------------------------------------------
4641 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4643 implicit real*8 (a-h,o-z)
4644 include 'DIMENSIONS'
4645 include 'COMMON.LOCAL'
4646 include 'COMMON.IOUNITS'
4647 common /calcthet/ term1,term2,termm,diffak,ratak,
4648 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4649 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4650 C Calculate the contributions to both Gaussian lobes.
4651 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4652 C The "polynomial part" of the "standard deviation" of this part of
4656 sig=sig*thet_pred_mean+polthet(j,it)
4658 C Derivative of the "interior part" of the "standard deviation of the"
4659 C gamma-dependent Gaussian lobe in t_c.
4660 sigtc=3*polthet(3,it)
4662 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4665 C Set the parameters of both Gaussian lobes of the distribution.
4666 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4667 fac=sig*sig+sigc0(it)
4670 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4671 sigsqtc=-4.0D0*sigcsq*sigtc
4672 c print *,i,sig,sigtc,sigsqtc
4673 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4674 sigtc=-sigtc/(fac*fac)
4675 C Following variable is sigma(t_c)**(-2)
4676 sigcsq=sigcsq*sigcsq
4678 sig0inv=1.0D0/sig0i**2
4679 delthec=thetai-thet_pred_mean
4680 delthe0=thetai-theta0i
4681 term1=-0.5D0*sigcsq*delthec*delthec
4682 term2=-0.5D0*sig0inv*delthe0*delthe0
4683 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4684 C NaNs in taking the logarithm. We extract the largest exponent which is added
4685 C to the energy (this being the log of the distribution) at the end of energy
4686 C term evaluation for this virtual-bond angle.
4687 if (term1.gt.term2) then
4689 term2=dexp(term2-termm)
4693 term1=dexp(term1-termm)
4696 C The ratio between the gamma-independent and gamma-dependent lobes of
4697 C the distribution is a Gaussian function of thet_pred_mean too.
4698 diffak=gthet(2,it)-thet_pred_mean
4699 ratak=diffak/gthet(3,it)**2
4700 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4701 C Let's differentiate it in thet_pred_mean NOW.
4703 C Now put together the distribution terms to make complete distribution.
4704 termexp=term1+ak*term2
4705 termpre=sigc+ak*sig0i
4706 C Contribution of the bending energy from this theta is just the -log of
4707 C the sum of the contributions from the two lobes and the pre-exponential
4708 C factor. Simple enough, isn't it?
4709 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4710 C NOW the derivatives!!!
4711 C 6/6/97 Take into account the deformation.
4712 E_theta=(delthec*sigcsq*term1
4713 & +ak*delthe0*sig0inv*term2)/termexp
4714 E_tc=((sigtc+aktc*sig0i)/termpre
4715 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4716 & aktc*term2)/termexp)
4719 c-----------------------------------------------------------------------------
4720 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4721 implicit real*8 (a-h,o-z)
4722 include 'DIMENSIONS'
4723 include 'COMMON.LOCAL'
4724 include 'COMMON.IOUNITS'
4725 common /calcthet/ term1,term2,termm,diffak,ratak,
4726 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4727 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4728 delthec=thetai-thet_pred_mean
4729 delthe0=thetai-theta0i
4730 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4731 t3 = thetai-thet_pred_mean
4735 t14 = t12+t6*sigsqtc
4737 t21 = thetai-theta0i
4743 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4744 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4745 & *(-t12*t9-ak*sig0inv*t27)
4749 C--------------------------------------------------------------------------
4750 subroutine ebend(etheta)
4752 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4753 C angles gamma and its derivatives in consecutive thetas and gammas.
4754 C ab initio-derived potentials from
4755 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4757 implicit real*8 (a-h,o-z)
4758 include 'DIMENSIONS'
4759 include 'COMMON.LOCAL'
4760 include 'COMMON.GEO'
4761 include 'COMMON.INTERACT'
4762 include 'COMMON.DERIV'
4763 include 'COMMON.VAR'
4764 include 'COMMON.CHAIN'
4765 include 'COMMON.IOUNITS'
4766 include 'COMMON.NAMES'
4767 include 'COMMON.FFIELD'
4768 include 'COMMON.CONTROL'
4769 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4770 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4771 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4772 & sinph1ph2(maxdouble,maxdouble)
4773 logical lprn /.false./, lprn1 /.false./
4775 do i=ithet_start,ithet_end
4779 theti2=0.5d0*theta(i)
4780 ityp2=ithetyp(itype(i-1))
4782 coskt(k)=dcos(k*theti2)
4783 sinkt(k)=dsin(k*theti2)
4788 if (phii.ne.phii) phii=150.0
4792 ityp1=ithetyp(itype(i-2))
4794 cosph1(k)=dcos(k*phii)
4795 sinph1(k)=dsin(k*phii)
4808 if (phii1.ne.phii1) phii1=150.0
4813 ityp3=ithetyp(itype(i))
4815 cosph2(k)=dcos(k*phii1)
4816 sinph2(k)=dsin(k*phii1)
4826 ethetai=aa0thet(ityp1,ityp2,ityp3)
4829 ccl=cosph1(l)*cosph2(k-l)
4830 ssl=sinph1(l)*sinph2(k-l)
4831 scl=sinph1(l)*cosph2(k-l)
4832 csl=cosph1(l)*sinph2(k-l)
4833 cosph1ph2(l,k)=ccl-ssl
4834 cosph1ph2(k,l)=ccl+ssl
4835 sinph1ph2(l,k)=scl+csl
4836 sinph1ph2(k,l)=scl-csl
4840 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4841 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4842 write (iout,*) "coskt and sinkt"
4844 write (iout,*) k,coskt(k),sinkt(k)
4848 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4849 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4852 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4853 & " ethetai",ethetai
4856 write (iout,*) "cosph and sinph"
4858 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4860 write (iout,*) "cosph1ph2 and sinph2ph2"
4863 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4864 & sinph1ph2(l,k),sinph1ph2(k,l)
4867 write(iout,*) "ethetai",ethetai
4871 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4872 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4873 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4874 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4875 ethetai=ethetai+sinkt(m)*aux
4876 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4877 dephii=dephii+k*sinkt(m)*(
4878 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4879 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4880 dephii1=dephii1+k*sinkt(m)*(
4881 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4882 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4884 & write (iout,*) "m",m," k",k," bbthet",
4885 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4886 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4887 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4888 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4892 & write(iout,*) "ethetai",ethetai
4896 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4897 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4898 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4899 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4900 ethetai=ethetai+sinkt(m)*aux
4901 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4902 dephii=dephii+l*sinkt(m)*(
4903 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4904 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4905 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4906 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4907 dephii1=dephii1+(k-l)*sinkt(m)*(
4908 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4909 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4910 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4911 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4913 write (iout,*) "m",m," k",k," l",l," ffthet",
4914 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4915 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4916 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4917 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4918 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4919 & cosph1ph2(k,l)*sinkt(m),
4920 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4926 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4927 & i,theta(i)*rad2deg,phii*rad2deg,
4928 & phii1*rad2deg,ethetai
4929 etheta=etheta+ethetai
4930 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4931 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4932 gloc(nphi+i-2,icg)=wang*dethetai
4938 c-----------------------------------------------------------------------------
4939 subroutine esc(escloc)
4940 C Calculate the local energy of a side chain and its derivatives in the
4941 C corresponding virtual-bond valence angles THETA and the spherical angles
4943 implicit real*8 (a-h,o-z)
4944 include 'DIMENSIONS'
4945 include 'COMMON.GEO'
4946 include 'COMMON.LOCAL'
4947 include 'COMMON.VAR'
4948 include 'COMMON.INTERACT'
4949 include 'COMMON.DERIV'
4950 include 'COMMON.CHAIN'
4951 include 'COMMON.IOUNITS'
4952 include 'COMMON.NAMES'
4953 include 'COMMON.FFIELD'
4954 include 'COMMON.CONTROL'
4955 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4956 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4957 common /sccalc/ time11,time12,time112,theti,it,nlobit
4960 c write (iout,'(a)') 'ESC'
4961 do i=loc_start,loc_end
4963 if (it.eq.10) goto 1
4965 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4966 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4967 theti=theta(i+1)-pipol
4972 if (x(2).gt.pi-delta) then
4976 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4978 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4979 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4981 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4982 & ddersc0(1),dersc(1))
4983 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4984 & ddersc0(3),dersc(3))
4986 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4988 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4989 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4990 & dersc0(2),esclocbi,dersc02)
4991 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4993 call splinthet(x(2),0.5d0*delta,ss,ssd)
4998 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5000 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5001 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5003 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5005 c write (iout,*) escloci
5006 else if (x(2).lt.delta) then
5010 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5012 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5013 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5015 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5016 & ddersc0(1),dersc(1))
5017 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5018 & ddersc0(3),dersc(3))
5020 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5022 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5023 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5024 & dersc0(2),esclocbi,dersc02)
5025 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5030 call splinthet(x(2),0.5d0*delta,ss,ssd)
5032 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5034 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5035 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5037 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5038 c write (iout,*) escloci
5040 call enesc(x,escloci,dersc,ddummy,.false.)
5043 escloc=escloc+escloci
5044 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5045 & 'escloc',i,escloci
5046 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5048 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5050 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5051 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5056 C---------------------------------------------------------------------------
5057 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5058 implicit real*8 (a-h,o-z)
5059 include 'DIMENSIONS'
5060 include 'COMMON.GEO'
5061 include 'COMMON.LOCAL'
5062 include 'COMMON.IOUNITS'
5063 common /sccalc/ time11,time12,time112,theti,it,nlobit
5064 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5065 double precision contr(maxlob,-1:1)
5067 c write (iout,*) 'it=',it,' nlobit=',nlobit
5071 if (mixed) ddersc(j)=0.0d0
5075 C Because of periodicity of the dependence of the SC energy in omega we have
5076 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5077 C To avoid underflows, first compute & store the exponents.
5085 z(k)=x(k)-censc(k,j,it)
5090 Axk=Axk+gaussc(l,k,j,it)*z(l)
5096 expfac=expfac+Ax(k,j,iii)*z(k)
5104 C As in the case of ebend, we want to avoid underflows in exponentiation and
5105 C subsequent NaNs and INFs in energy calculation.
5106 C Find the largest exponent
5110 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5114 cd print *,'it=',it,' emin=',emin
5116 C Compute the contribution to SC energy and derivatives
5121 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5122 if(adexp.ne.adexp) adexp=1.0
5125 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5127 cd print *,'j=',j,' expfac=',expfac
5128 escloc_i=escloc_i+expfac
5130 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5134 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5135 & +gaussc(k,2,j,it))*expfac
5142 dersc(1)=dersc(1)/cos(theti)**2
5143 ddersc(1)=ddersc(1)/cos(theti)**2
5146 escloci=-(dlog(escloc_i)-emin)
5148 dersc(j)=dersc(j)/escloc_i
5152 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5157 C------------------------------------------------------------------------------
5158 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5159 implicit real*8 (a-h,o-z)
5160 include 'DIMENSIONS'
5161 include 'COMMON.GEO'
5162 include 'COMMON.LOCAL'
5163 include 'COMMON.IOUNITS'
5164 common /sccalc/ time11,time12,time112,theti,it,nlobit
5165 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5166 double precision contr(maxlob)
5177 z(k)=x(k)-censc(k,j,it)
5183 Axk=Axk+gaussc(l,k,j,it)*z(l)
5189 expfac=expfac+Ax(k,j)*z(k)
5194 C As in the case of ebend, we want to avoid underflows in exponentiation and
5195 C subsequent NaNs and INFs in energy calculation.
5196 C Find the largest exponent
5199 if (emin.gt.contr(j)) emin=contr(j)
5203 C Compute the contribution to SC energy and derivatives
5207 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5208 escloc_i=escloc_i+expfac
5210 dersc(k)=dersc(k)+Ax(k,j)*expfac
5212 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5213 & +gaussc(1,2,j,it))*expfac
5217 dersc(1)=dersc(1)/cos(theti)**2
5218 dersc12=dersc12/cos(theti)**2
5219 escloci=-(dlog(escloc_i)-emin)
5221 dersc(j)=dersc(j)/escloc_i
5223 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5227 c----------------------------------------------------------------------------------
5228 subroutine esc(escloc)
5229 C Calculate the local energy of a side chain and its derivatives in the
5230 C corresponding virtual-bond valence angles THETA and the spherical angles
5231 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5232 C added by Urszula Kozlowska. 07/11/2007
5234 implicit real*8 (a-h,o-z)
5235 include 'DIMENSIONS'
5236 include 'COMMON.GEO'
5237 include 'COMMON.LOCAL'
5238 include 'COMMON.VAR'
5239 include 'COMMON.SCROT'
5240 include 'COMMON.INTERACT'
5241 include 'COMMON.DERIV'
5242 include 'COMMON.CHAIN'
5243 include 'COMMON.IOUNITS'
5244 include 'COMMON.NAMES'
5245 include 'COMMON.FFIELD'
5246 include 'COMMON.CONTROL'
5247 include 'COMMON.VECTORS'
5248 double precision x_prime(3),y_prime(3),z_prime(3)
5249 & , sumene,dsc_i,dp2_i,x(65),
5250 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5251 & de_dxx,de_dyy,de_dzz,de_dt
5252 double precision s1_t,s1_6_t,s2_t,s2_6_t
5254 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5255 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5256 & dt_dCi(3),dt_dCi1(3)
5257 common /sccalc/ time11,time12,time112,theti,it,nlobit
5260 do i=loc_start,loc_end
5261 costtab(i+1) =dcos(theta(i+1))
5262 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5263 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5264 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5265 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5266 cosfac=dsqrt(cosfac2)
5267 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5268 sinfac=dsqrt(sinfac2)
5270 if (it.eq.10) goto 1
5272 C Compute the axes of tghe local cartesian coordinates system; store in
5273 c x_prime, y_prime and z_prime
5280 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5281 C & dc_norm(3,i+nres)
5283 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5284 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5287 z_prime(j) = -uz(j,i-1)
5290 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5291 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5292 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5293 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5294 c & " xy",scalar(x_prime(1),y_prime(1)),
5295 c & " xz",scalar(x_prime(1),z_prime(1)),
5296 c & " yy",scalar(y_prime(1),y_prime(1)),
5297 c & " yz",scalar(y_prime(1),z_prime(1)),
5298 c & " zz",scalar(z_prime(1),z_prime(1))
5300 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5301 C to local coordinate system. Store in xx, yy, zz.
5307 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5308 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5309 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5316 C Compute the energy of the ith side cbain
5318 c write (2,*) "xx",xx," yy",yy," zz",zz
5321 x(j) = sc_parmin(j,it)
5324 Cc diagnostics - remove later
5326 yy1 = dsin(alph(2))*dcos(omeg(2))
5327 zz1 = -dsin(alph(2))*dsin(omeg(2))
5328 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5329 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5331 C," --- ", xx_w,yy_w,zz_w
5334 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5335 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5337 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5338 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5340 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5341 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5342 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5343 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5344 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5346 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5347 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5348 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5349 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5350 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5352 dsc_i = 0.743d0+x(61)
5354 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5355 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5356 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5357 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5358 s1=(1+x(63))/(0.1d0 + dscp1)
5359 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5360 s2=(1+x(65))/(0.1d0 + dscp2)
5361 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5362 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5363 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5364 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5366 c & dscp1,dscp2,sumene
5367 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5368 escloc = escloc + sumene
5369 c write (2,*) "i",i," escloc",sumene,escloc
5372 C This section to check the numerical derivatives of the energy of ith side
5373 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5374 C #define DEBUG in the code to turn it on.
5376 write (2,*) "sumene =",sumene
5380 write (2,*) xx,yy,zz
5381 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5382 de_dxx_num=(sumenep-sumene)/aincr
5384 write (2,*) "xx+ sumene from enesc=",sumenep
5387 write (2,*) xx,yy,zz
5388 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5389 de_dyy_num=(sumenep-sumene)/aincr
5391 write (2,*) "yy+ sumene from enesc=",sumenep
5394 write (2,*) xx,yy,zz
5395 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5396 de_dzz_num=(sumenep-sumene)/aincr
5398 write (2,*) "zz+ sumene from enesc=",sumenep
5399 costsave=cost2tab(i+1)
5400 sintsave=sint2tab(i+1)
5401 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5402 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5403 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5404 de_dt_num=(sumenep-sumene)/aincr
5405 write (2,*) " t+ sumene from enesc=",sumenep
5406 cost2tab(i+1)=costsave
5407 sint2tab(i+1)=sintsave
5408 C End of diagnostics section.
5411 C Compute the gradient of esc
5413 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5414 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5415 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5416 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5417 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5418 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5419 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5420 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5421 pom1=(sumene3*sint2tab(i+1)+sumene1)
5422 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5423 pom2=(sumene4*cost2tab(i+1)+sumene2)
5424 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5425 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5426 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5427 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5429 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5430 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5431 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5433 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5434 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5435 & +(pom1+pom2)*pom_dx
5437 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5440 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5441 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5442 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5444 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5445 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5446 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5447 & +x(59)*zz**2 +x(60)*xx*zz
5448 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5449 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5450 & +(pom1-pom2)*pom_dy
5452 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5455 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5456 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5457 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5458 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5459 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5460 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5461 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5462 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5464 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5467 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5468 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5469 & +pom1*pom_dt1+pom2*pom_dt2
5471 write(2,*), "de_dt = ", de_dt,de_dt_num
5475 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5476 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5477 cosfac2xx=cosfac2*xx
5478 sinfac2yy=sinfac2*yy
5480 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5482 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5484 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5485 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5486 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5487 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5488 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5489 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5490 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5491 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5492 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5493 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5497 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5498 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5501 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5502 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5503 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5505 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5506 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5510 dXX_Ctab(k,i)=dXX_Ci(k)
5511 dXX_C1tab(k,i)=dXX_Ci1(k)
5512 dYY_Ctab(k,i)=dYY_Ci(k)
5513 dYY_C1tab(k,i)=dYY_Ci1(k)
5514 dZZ_Ctab(k,i)=dZZ_Ci(k)
5515 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5516 dXX_XYZtab(k,i)=dXX_XYZ(k)
5517 dYY_XYZtab(k,i)=dYY_XYZ(k)
5518 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5522 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5523 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5524 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5525 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5526 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5528 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5529 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5530 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5531 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5532 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5533 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5534 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5535 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5537 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5538 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5540 C to check gradient call subroutine check_grad
5546 c------------------------------------------------------------------------------
5547 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5549 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5550 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5551 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5552 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5554 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5555 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5557 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5558 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5559 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5560 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5561 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5563 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5564 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5565 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5566 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5567 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5569 dsc_i = 0.743d0+x(61)
5571 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5572 & *(xx*cost2+yy*sint2))
5573 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5574 & *(xx*cost2-yy*sint2))
5575 s1=(1+x(63))/(0.1d0 + dscp1)
5576 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5577 s2=(1+x(65))/(0.1d0 + dscp2)
5578 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5579 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5580 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5585 c------------------------------------------------------------------------------
5586 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5588 C This procedure calculates two-body contact function g(rij) and its derivative:
5591 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5594 C where x=(rij-r0ij)/delta
5596 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5599 double precision rij,r0ij,eps0ij,fcont,fprimcont
5600 double precision x,x2,x4,delta
5604 if (x.lt.-1.0D0) then
5607 else if (x.le.1.0D0) then
5610 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5611 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5618 c------------------------------------------------------------------------------
5619 subroutine splinthet(theti,delta,ss,ssder)
5620 implicit real*8 (a-h,o-z)
5621 include 'DIMENSIONS'
5622 include 'COMMON.VAR'
5623 include 'COMMON.GEO'
5626 if (theti.gt.pipol) then
5627 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5629 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5634 c------------------------------------------------------------------------------
5635 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5637 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5638 double precision ksi,ksi2,ksi3,a1,a2,a3
5639 a1=fprim0*delta/(f1-f0)
5645 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5646 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5649 c------------------------------------------------------------------------------
5650 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5652 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5653 double precision ksi,ksi2,ksi3,a1,a2,a3
5658 a2=3*(f1x-f0x)-2*fprim0x*delta
5659 a3=fprim0x*delta-2*(f1x-f0x)
5660 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5663 C-----------------------------------------------------------------------------
5665 C-----------------------------------------------------------------------------
5666 subroutine etor(etors,edihcnstr)
5667 implicit real*8 (a-h,o-z)
5668 include 'DIMENSIONS'
5669 include 'COMMON.VAR'
5670 include 'COMMON.GEO'
5671 include 'COMMON.LOCAL'
5672 include 'COMMON.TORSION'
5673 include 'COMMON.INTERACT'
5674 include 'COMMON.DERIV'
5675 include 'COMMON.CHAIN'
5676 include 'COMMON.NAMES'
5677 include 'COMMON.IOUNITS'
5678 include 'COMMON.FFIELD'
5679 include 'COMMON.TORCNSTR'
5680 include 'COMMON.CONTROL'
5682 C Set lprn=.true. for debugging
5686 do i=iphi_start,iphi_end
5688 itori=itortyp(itype(i-2))
5689 itori1=itortyp(itype(i-1))
5692 C Proline-Proline pair is a special case...
5693 if (itori.eq.3 .and. itori1.eq.3) then
5694 if (phii.gt.-dwapi3) then
5696 fac=1.0D0/(1.0D0-cosphi)
5697 etorsi=v1(1,3,3)*fac
5698 etorsi=etorsi+etorsi
5699 etors=etors+etorsi-v1(1,3,3)
5700 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5701 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5704 v1ij=v1(j+1,itori,itori1)
5705 v2ij=v2(j+1,itori,itori1)
5708 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5709 if (energy_dec) etors_ii=etors_ii+
5710 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5711 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5715 v1ij=v1(j,itori,itori1)
5716 v2ij=v2(j,itori,itori1)
5719 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5720 if (energy_dec) etors_ii=etors_ii+
5721 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5722 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5725 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5728 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5729 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5730 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5731 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5732 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5734 ! 6/20/98 - dihedral angle constraints
5737 itori=idih_constr(i)
5740 if (difi.gt.drange(i)) then
5742 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5743 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5744 else if (difi.lt.-drange(i)) then
5746 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5747 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5749 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5750 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5752 ! write (iout,*) 'edihcnstr',edihcnstr
5755 c------------------------------------------------------------------------------
5756 subroutine etor_d(etors_d)
5760 c----------------------------------------------------------------------------
5762 subroutine etor(etors,edihcnstr)
5763 implicit real*8 (a-h,o-z)
5764 include 'DIMENSIONS'
5765 include 'COMMON.VAR'
5766 include 'COMMON.GEO'
5767 include 'COMMON.LOCAL'
5768 include 'COMMON.TORSION'
5769 include 'COMMON.INTERACT'
5770 include 'COMMON.DERIV'
5771 include 'COMMON.CHAIN'
5772 include 'COMMON.NAMES'
5773 include 'COMMON.IOUNITS'
5774 include 'COMMON.FFIELD'
5775 include 'COMMON.TORCNSTR'
5776 include 'COMMON.CONTROL'
5778 C Set lprn=.true. for debugging
5782 do i=iphi_start,iphi_end
5784 itori=itortyp(itype(i-2))
5785 itori1=itortyp(itype(i-1))
5788 C Regular cosine and sine terms
5789 do j=1,nterm(itori,itori1)
5790 v1ij=v1(j,itori,itori1)
5791 v2ij=v2(j,itori,itori1)
5794 etors=etors+v1ij*cosphi+v2ij*sinphi
5795 if (energy_dec) etors_ii=etors_ii+
5796 & v1ij*cosphi+v2ij*sinphi
5797 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5801 C E = SUM ----------------------------------- - v1
5802 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5804 cosphi=dcos(0.5d0*phii)
5805 sinphi=dsin(0.5d0*phii)
5806 do j=1,nlor(itori,itori1)
5807 vl1ij=vlor1(j,itori,itori1)
5808 vl2ij=vlor2(j,itori,itori1)
5809 vl3ij=vlor3(j,itori,itori1)
5810 pom=vl2ij*cosphi+vl3ij*sinphi
5811 pom1=1.0d0/(pom*pom+1.0d0)
5812 etors=etors+vl1ij*pom1
5813 if (energy_dec) etors_ii=etors_ii+
5816 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5818 C Subtract the constant term
5819 etors=etors-v0(itori,itori1)
5820 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5821 & 'etor',i,etors_ii-v0(itori,itori1)
5823 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5824 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5825 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5826 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5827 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5829 ! 6/20/98 - dihedral angle constraints
5831 c do i=1,ndih_constr
5832 do i=idihconstr_start,idihconstr_end
5833 itori=idih_constr(i)
5835 difi=pinorm(phii-phi0(i))
5836 if (difi.gt.drange(i)) then
5838 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5839 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5840 else if (difi.lt.-drange(i)) then
5842 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5843 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5847 c write (iout,*) "gloci", gloc(i-3,icg)
5848 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5849 cd & rad2deg*phi0(i), rad2deg*drange(i),
5850 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5852 cd write (iout,*) 'edihcnstr',edihcnstr
5855 c----------------------------------------------------------------------------
5856 subroutine etor_d(etors_d)
5857 C 6/23/01 Compute double torsional energy
5858 implicit real*8 (a-h,o-z)
5859 include 'DIMENSIONS'
5860 include 'COMMON.VAR'
5861 include 'COMMON.GEO'
5862 include 'COMMON.LOCAL'
5863 include 'COMMON.TORSION'
5864 include 'COMMON.INTERACT'
5865 include 'COMMON.DERIV'
5866 include 'COMMON.CHAIN'
5867 include 'COMMON.NAMES'
5868 include 'COMMON.IOUNITS'
5869 include 'COMMON.FFIELD'
5870 include 'COMMON.TORCNSTR'
5872 C Set lprn=.true. for debugging
5876 do i=iphid_start,iphid_end
5877 itori=itortyp(itype(i-2))
5878 itori1=itortyp(itype(i-1))
5879 itori2=itortyp(itype(i))
5884 do j=1,ntermd_1(itori,itori1,itori2)
5885 v1cij=v1c(1,j,itori,itori1,itori2)
5886 v1sij=v1s(1,j,itori,itori1,itori2)
5887 v2cij=v1c(2,j,itori,itori1,itori2)
5888 v2sij=v1s(2,j,itori,itori1,itori2)
5889 cosphi1=dcos(j*phii)
5890 sinphi1=dsin(j*phii)
5891 cosphi2=dcos(j*phii1)
5892 sinphi2=dsin(j*phii1)
5893 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5894 & v2cij*cosphi2+v2sij*sinphi2
5895 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5896 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5898 do k=2,ntermd_2(itori,itori1,itori2)
5900 v1cdij = v2c(k,l,itori,itori1,itori2)
5901 v2cdij = v2c(l,k,itori,itori1,itori2)
5902 v1sdij = v2s(k,l,itori,itori1,itori2)
5903 v2sdij = v2s(l,k,itori,itori1,itori2)
5904 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5905 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5906 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5907 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5908 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5909 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5910 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5911 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5912 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5913 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5916 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5917 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5918 c write (iout,*) "gloci", gloc(i-3,icg)
5923 c------------------------------------------------------------------------------
5924 subroutine eback_sc_corr(esccor)
5925 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5926 c conformational states; temporarily implemented as differences
5927 c between UNRES torsional potentials (dependent on three types of
5928 c residues) and the torsional potentials dependent on all 20 types
5929 c of residues computed from AM1 energy surfaces of terminally-blocked
5930 c amino-acid residues.
5931 implicit real*8 (a-h,o-z)
5932 include 'DIMENSIONS'
5933 include 'COMMON.VAR'
5934 include 'COMMON.GEO'
5935 include 'COMMON.LOCAL'
5936 include 'COMMON.TORSION'
5937 include 'COMMON.SCCOR'
5938 include 'COMMON.INTERACT'
5939 include 'COMMON.DERIV'
5940 include 'COMMON.CHAIN'
5941 include 'COMMON.NAMES'
5942 include 'COMMON.IOUNITS'
5943 include 'COMMON.FFIELD'
5944 include 'COMMON.CONTROL'
5946 C Set lprn=.true. for debugging
5949 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5951 do i=itau_start,itau_end
5953 isccori=isccortyp(itype(i-2))
5954 isccori1=isccortyp(itype(i-1))
5956 cccc Added 9 May 2012
5957 cc Tauangle is torsional engle depending on the value of first digit
5958 c(see comment below)
5959 cc Omicron is flat angle depending on the value of first digit
5960 c(see comment below)
5963 do intertyp=1,3 !intertyp
5964 cc Added 09 May 2012 (Adasko)
5965 cc Intertyp means interaction type of backbone mainchain correlation:
5966 c 1 = SC...Ca...Ca...Ca
5967 c 2 = Ca...Ca...Ca...SC
5968 c 3 = SC...Ca...Ca...SCi
5970 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5971 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5972 & (itype(i-1).eq.21)))
5973 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5974 & .or.(itype(i-2).eq.21)))
5975 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5976 & (itype(i-1).eq.21)))) cycle
5977 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5978 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5980 do j=1,nterm_sccor(isccori,isccori1)
5981 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5982 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5983 cosphi=dcos(j*tauangle(intertyp,i))
5984 sinphi=dsin(j*tauangle(intertyp,i))
5985 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5986 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5988 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5989 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5990 c &gloc_sc(intertyp,i-3,icg)
5992 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5993 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5994 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5995 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5996 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6000 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6004 c----------------------------------------------------------------------------
6005 subroutine multibody(ecorr)
6006 C This subroutine calculates multi-body contributions to energy following
6007 C the idea of Skolnick et al. If side chains I and J make a contact and
6008 C at the same time side chains I+1 and J+1 make a contact, an extra
6009 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6010 implicit real*8 (a-h,o-z)
6011 include 'DIMENSIONS'
6012 include 'COMMON.IOUNITS'
6013 include 'COMMON.DERIV'
6014 include 'COMMON.INTERACT'
6015 include 'COMMON.CONTACTS'
6016 double precision gx(3),gx1(3)
6019 C Set lprn=.true. for debugging
6023 write (iout,'(a)') 'Contact function values:'
6025 write (iout,'(i2,20(1x,i2,f10.5))')
6026 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6041 num_conti=num_cont(i)
6042 num_conti1=num_cont(i1)
6047 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6048 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6049 cd & ' ishift=',ishift
6050 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6051 C The system gains extra energy.
6052 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6053 endif ! j1==j+-ishift
6062 c------------------------------------------------------------------------------
6063 double precision function esccorr(i,j,k,l,jj,kk)
6064 implicit real*8 (a-h,o-z)
6065 include 'DIMENSIONS'
6066 include 'COMMON.IOUNITS'
6067 include 'COMMON.DERIV'
6068 include 'COMMON.INTERACT'
6069 include 'COMMON.CONTACTS'
6070 double precision gx(3),gx1(3)
6075 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6076 C Calculate the multi-body contribution to energy.
6077 C Calculate multi-body contributions to the gradient.
6078 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6079 cd & k,l,(gacont(m,kk,k),m=1,3)
6081 gx(m) =ekl*gacont(m,jj,i)
6082 gx1(m)=eij*gacont(m,kk,k)
6083 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6084 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6085 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6086 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6090 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6095 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6101 c------------------------------------------------------------------------------
6102 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6103 C This subroutine calculates multi-body contributions to hydrogen-bonding
6104 implicit real*8 (a-h,o-z)
6105 include 'DIMENSIONS'
6106 include 'COMMON.IOUNITS'
6109 parameter (max_cont=maxconts)
6110 parameter (max_dim=26)
6111 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6112 double precision zapas(max_dim,maxconts,max_fg_procs),
6113 & zapas_recv(max_dim,maxconts,max_fg_procs)
6114 common /przechowalnia/ zapas
6115 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6116 & status_array(MPI_STATUS_SIZE,maxconts*2)
6118 include 'COMMON.SETUP'
6119 include 'COMMON.FFIELD'
6120 include 'COMMON.DERIV'
6121 include 'COMMON.INTERACT'
6122 include 'COMMON.CONTACTS'
6123 include 'COMMON.CONTROL'
6124 include 'COMMON.LOCAL'
6125 double precision gx(3),gx1(3),time00
6128 C Set lprn=.true. for debugging
6133 if (nfgtasks.le.1) goto 30
6135 write (iout,'(a)') 'Contact function values before RECEIVE:'
6137 write (iout,'(2i3,50(1x,i2,f5.2))')
6138 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6139 & j=1,num_cont_hb(i))
6143 do i=1,ntask_cont_from
6146 do i=1,ntask_cont_to
6149 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6151 C Make the list of contacts to send to send to other procesors
6152 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6154 do i=iturn3_start,iturn3_end
6155 c write (iout,*) "make contact list turn3",i," num_cont",
6157 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6159 do i=iturn4_start,iturn4_end
6160 c write (iout,*) "make contact list turn4",i," num_cont",
6162 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6166 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6168 do j=1,num_cont_hb(i)
6171 iproc=iint_sent_local(k,jjc,ii)
6172 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6173 if (iproc.gt.0) then
6174 ncont_sent(iproc)=ncont_sent(iproc)+1
6175 nn=ncont_sent(iproc)
6177 zapas(2,nn,iproc)=jjc
6178 zapas(3,nn,iproc)=facont_hb(j,i)
6179 zapas(4,nn,iproc)=ees0p(j,i)
6180 zapas(5,nn,iproc)=ees0m(j,i)
6181 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6182 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6183 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6184 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6185 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6186 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6187 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6188 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6189 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6190 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6191 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6192 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6193 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6194 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6195 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6196 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6197 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6198 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6199 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6200 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6201 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6208 & "Numbers of contacts to be sent to other processors",
6209 & (ncont_sent(i),i=1,ntask_cont_to)
6210 write (iout,*) "Contacts sent"
6211 do ii=1,ntask_cont_to
6213 iproc=itask_cont_to(ii)
6214 write (iout,*) nn," contacts to processor",iproc,
6215 & " of CONT_TO_COMM group"
6217 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6225 CorrelID1=nfgtasks+fg_rank+1
6227 C Receive the numbers of needed contacts from other processors
6228 do ii=1,ntask_cont_from
6229 iproc=itask_cont_from(ii)
6231 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6232 & FG_COMM,req(ireq),IERR)
6234 c write (iout,*) "IRECV ended"
6236 C Send the number of contacts needed by other processors
6237 do ii=1,ntask_cont_to
6238 iproc=itask_cont_to(ii)
6240 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6241 & FG_COMM,req(ireq),IERR)
6243 c write (iout,*) "ISEND ended"
6244 c write (iout,*) "number of requests (nn)",ireq
6247 & call MPI_Waitall(ireq,req,status_array,ierr)
6249 c & "Numbers of contacts to be received from other processors",
6250 c & (ncont_recv(i),i=1,ntask_cont_from)
6254 do ii=1,ntask_cont_from
6255 iproc=itask_cont_from(ii)
6257 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6258 c & " of CONT_TO_COMM group"
6262 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6263 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6264 c write (iout,*) "ireq,req",ireq,req(ireq)
6267 C Send the contacts to processors that need them
6268 do ii=1,ntask_cont_to
6269 iproc=itask_cont_to(ii)
6271 c write (iout,*) nn," contacts to processor",iproc,
6272 c & " of CONT_TO_COMM group"
6275 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6276 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6277 c write (iout,*) "ireq,req",ireq,req(ireq)
6279 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6283 c write (iout,*) "number of requests (contacts)",ireq
6284 c write (iout,*) "req",(req(i),i=1,4)
6287 & call MPI_Waitall(ireq,req,status_array,ierr)
6288 do iii=1,ntask_cont_from
6289 iproc=itask_cont_from(iii)
6292 write (iout,*) "Received",nn," contacts from processor",iproc,
6293 & " of CONT_FROM_COMM group"
6296 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6301 ii=zapas_recv(1,i,iii)
6302 c Flag the received contacts to prevent double-counting
6303 jj=-zapas_recv(2,i,iii)
6304 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6306 nnn=num_cont_hb(ii)+1
6309 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6310 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6311 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6312 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6313 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6314 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6315 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6316 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6317 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6318 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6319 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6320 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6321 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6322 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6323 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6324 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6325 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6326 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6327 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6328 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6329 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6330 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6331 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6332 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6337 write (iout,'(a)') 'Contact function values after receive:'
6339 write (iout,'(2i3,50(1x,i3,f5.2))')
6340 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6341 & j=1,num_cont_hb(i))
6348 write (iout,'(a)') 'Contact function values:'
6350 write (iout,'(2i3,50(1x,i3,f5.2))')
6351 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6352 & j=1,num_cont_hb(i))
6356 C Remove the loop below after debugging !!!
6363 C Calculate the local-electrostatic correlation terms
6364 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6366 num_conti=num_cont_hb(i)
6367 num_conti1=num_cont_hb(i+1)
6374 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6375 c & ' jj=',jj,' kk=',kk
6376 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6377 & .or. j.lt.0 .and. j1.gt.0) .and.
6378 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6379 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6380 C The system gains extra energy.
6381 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6382 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6383 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6385 else if (j1.eq.j) then
6386 C Contacts I-J and I-(J+1) occur simultaneously.
6387 C The system loses extra energy.
6388 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6393 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6394 c & ' jj=',jj,' kk=',kk
6396 C Contacts I-J and (I+1)-J occur simultaneously.
6397 C The system loses extra energy.
6398 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6405 c------------------------------------------------------------------------------
6406 subroutine add_hb_contact(ii,jj,itask)
6407 implicit real*8 (a-h,o-z)
6408 include "DIMENSIONS"
6409 include "COMMON.IOUNITS"
6412 parameter (max_cont=maxconts)
6413 parameter (max_dim=26)
6414 include "COMMON.CONTACTS"
6415 double precision zapas(max_dim,maxconts,max_fg_procs),
6416 & zapas_recv(max_dim,maxconts,max_fg_procs)
6417 common /przechowalnia/ zapas
6418 integer i,j,ii,jj,iproc,itask(4),nn
6419 c write (iout,*) "itask",itask
6422 if (iproc.gt.0) then
6423 do j=1,num_cont_hb(ii)
6425 c write (iout,*) "i",ii," j",jj," jjc",jjc
6427 ncont_sent(iproc)=ncont_sent(iproc)+1
6428 nn=ncont_sent(iproc)
6429 zapas(1,nn,iproc)=ii
6430 zapas(2,nn,iproc)=jjc
6431 zapas(3,nn,iproc)=facont_hb(j,ii)
6432 zapas(4,nn,iproc)=ees0p(j,ii)
6433 zapas(5,nn,iproc)=ees0m(j,ii)
6434 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6435 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6436 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6437 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6438 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6439 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6440 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6441 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6442 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6443 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6444 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6445 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6446 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6447 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6448 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6449 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6450 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6451 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6452 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6453 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6454 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6462 c------------------------------------------------------------------------------
6463 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6465 C This subroutine calculates multi-body contributions to hydrogen-bonding
6466 implicit real*8 (a-h,o-z)
6467 include 'DIMENSIONS'
6468 include 'COMMON.IOUNITS'
6471 parameter (max_cont=maxconts)
6472 parameter (max_dim=70)
6473 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6474 double precision zapas(max_dim,maxconts,max_fg_procs),
6475 & zapas_recv(max_dim,maxconts,max_fg_procs)
6476 common /przechowalnia/ zapas
6477 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6478 & status_array(MPI_STATUS_SIZE,maxconts*2)
6480 include 'COMMON.SETUP'
6481 include 'COMMON.FFIELD'
6482 include 'COMMON.DERIV'
6483 include 'COMMON.LOCAL'
6484 include 'COMMON.INTERACT'
6485 include 'COMMON.CONTACTS'
6486 include 'COMMON.CHAIN'
6487 include 'COMMON.CONTROL'
6488 double precision gx(3),gx1(3)
6489 integer num_cont_hb_old(maxres)
6491 double precision eello4,eello5,eelo6,eello_turn6
6492 external eello4,eello5,eello6,eello_turn6
6493 C Set lprn=.true. for debugging
6498 num_cont_hb_old(i)=num_cont_hb(i)
6502 if (nfgtasks.le.1) goto 30
6504 write (iout,'(a)') 'Contact function values before RECEIVE:'
6506 write (iout,'(2i3,50(1x,i2,f5.2))')
6507 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6508 & j=1,num_cont_hb(i))
6512 do i=1,ntask_cont_from
6515 do i=1,ntask_cont_to
6518 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6520 C Make the list of contacts to send to send to other procesors
6521 do i=iturn3_start,iturn3_end
6522 c write (iout,*) "make contact list turn3",i," num_cont",
6524 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6526 do i=iturn4_start,iturn4_end
6527 c write (iout,*) "make contact list turn4",i," num_cont",
6529 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6533 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6535 do j=1,num_cont_hb(i)
6538 iproc=iint_sent_local(k,jjc,ii)
6539 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6540 if (iproc.ne.0) then
6541 ncont_sent(iproc)=ncont_sent(iproc)+1
6542 nn=ncont_sent(iproc)
6544 zapas(2,nn,iproc)=jjc
6545 zapas(3,nn,iproc)=d_cont(j,i)
6549 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6554 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6562 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6573 & "Numbers of contacts to be sent to other processors",
6574 & (ncont_sent(i),i=1,ntask_cont_to)
6575 write (iout,*) "Contacts sent"
6576 do ii=1,ntask_cont_to
6578 iproc=itask_cont_to(ii)
6579 write (iout,*) nn," contacts to processor",iproc,
6580 & " of CONT_TO_COMM group"
6582 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6590 CorrelID1=nfgtasks+fg_rank+1
6592 C Receive the numbers of needed contacts from other processors
6593 do ii=1,ntask_cont_from
6594 iproc=itask_cont_from(ii)
6596 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6597 & FG_COMM,req(ireq),IERR)
6599 c write (iout,*) "IRECV ended"
6601 C Send the number of contacts needed by other processors
6602 do ii=1,ntask_cont_to
6603 iproc=itask_cont_to(ii)
6605 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6606 & FG_COMM,req(ireq),IERR)
6608 c write (iout,*) "ISEND ended"
6609 c write (iout,*) "number of requests (nn)",ireq
6612 & call MPI_Waitall(ireq,req,status_array,ierr)
6614 c & "Numbers of contacts to be received from other processors",
6615 c & (ncont_recv(i),i=1,ntask_cont_from)
6619 do ii=1,ntask_cont_from
6620 iproc=itask_cont_from(ii)
6622 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6623 c & " of CONT_TO_COMM group"
6627 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6628 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6629 c write (iout,*) "ireq,req",ireq,req(ireq)
6632 C Send the contacts to processors that need them
6633 do ii=1,ntask_cont_to
6634 iproc=itask_cont_to(ii)
6636 c write (iout,*) nn," contacts to processor",iproc,
6637 c & " of CONT_TO_COMM group"
6640 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6641 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6642 c write (iout,*) "ireq,req",ireq,req(ireq)
6644 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6648 c write (iout,*) "number of requests (contacts)",ireq
6649 c write (iout,*) "req",(req(i),i=1,4)
6652 & call MPI_Waitall(ireq,req,status_array,ierr)
6653 do iii=1,ntask_cont_from
6654 iproc=itask_cont_from(iii)
6657 write (iout,*) "Received",nn," contacts from processor",iproc,
6658 & " of CONT_FROM_COMM group"
6661 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6666 ii=zapas_recv(1,i,iii)
6667 c Flag the received contacts to prevent double-counting
6668 jj=-zapas_recv(2,i,iii)
6669 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6671 nnn=num_cont_hb(ii)+1
6674 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6678 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6683 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6691 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6700 write (iout,'(a)') 'Contact function values after receive:'
6702 write (iout,'(2i3,50(1x,i3,5f6.3))')
6703 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6704 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6711 write (iout,'(a)') 'Contact function values:'
6713 write (iout,'(2i3,50(1x,i2,5f6.3))')
6714 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6715 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6721 C Remove the loop below after debugging !!!
6728 C Calculate the dipole-dipole interaction energies
6729 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6730 do i=iatel_s,iatel_e+1
6731 num_conti=num_cont_hb(i)
6740 C Calculate the local-electrostatic correlation terms
6741 c write (iout,*) "gradcorr5 in eello5 before loop"
6743 c write (iout,'(i5,3f10.5)')
6744 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6746 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6747 c write (iout,*) "corr loop i",i
6749 num_conti=num_cont_hb(i)
6750 num_conti1=num_cont_hb(i+1)
6757 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6758 c & ' jj=',jj,' kk=',kk
6759 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6760 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6761 & .or. j.lt.0 .and. j1.gt.0) .and.
6762 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6763 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6764 C The system gains extra energy.
6766 sqd1=dsqrt(d_cont(jj,i))
6767 sqd2=dsqrt(d_cont(kk,i1))
6768 sred_geom = sqd1*sqd2
6769 IF (sred_geom.lt.cutoff_corr) THEN
6770 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6772 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6773 cd & ' jj=',jj,' kk=',kk
6774 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6775 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6777 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6778 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6781 cd write (iout,*) 'sred_geom=',sred_geom,
6782 cd & ' ekont=',ekont,' fprim=',fprimcont,
6783 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6784 cd write (iout,*) "g_contij",g_contij
6785 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6786 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6787 call calc_eello(i,jp,i+1,jp1,jj,kk)
6788 if (wcorr4.gt.0.0d0)
6789 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6790 if (energy_dec.and.wcorr4.gt.0.0d0)
6791 1 write (iout,'(a6,4i5,0pf7.3)')
6792 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6793 c write (iout,*) "gradcorr5 before eello5"
6795 c write (iout,'(i5,3f10.5)')
6796 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6798 if (wcorr5.gt.0.0d0)
6799 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6800 c write (iout,*) "gradcorr5 after eello5"
6802 c write (iout,'(i5,3f10.5)')
6803 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6805 if (energy_dec.and.wcorr5.gt.0.0d0)
6806 1 write (iout,'(a6,4i5,0pf7.3)')
6807 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6808 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6809 cd write(2,*)'ijkl',i,jp,i+1,jp1
6810 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6811 & .or. wturn6.eq.0.0d0))then
6812 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6813 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6814 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6815 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6816 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6817 cd & 'ecorr6=',ecorr6
6818 cd write (iout,'(4e15.5)') sred_geom,
6819 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6820 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6821 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6822 else if (wturn6.gt.0.0d0
6823 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6824 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6825 eturn6=eturn6+eello_turn6(i,jj,kk)
6826 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6827 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6828 cd write (2,*) 'multibody_eello:eturn6',eturn6
6837 num_cont_hb(i)=num_cont_hb_old(i)
6839 c write (iout,*) "gradcorr5 in eello5"
6841 c write (iout,'(i5,3f10.5)')
6842 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6846 c------------------------------------------------------------------------------
6847 subroutine add_hb_contact_eello(ii,jj,itask)
6848 implicit real*8 (a-h,o-z)
6849 include "DIMENSIONS"
6850 include "COMMON.IOUNITS"
6853 parameter (max_cont=maxconts)
6854 parameter (max_dim=70)
6855 include "COMMON.CONTACTS"
6856 double precision zapas(max_dim,maxconts,max_fg_procs),
6857 & zapas_recv(max_dim,maxconts,max_fg_procs)
6858 common /przechowalnia/ zapas
6859 integer i,j,ii,jj,iproc,itask(4),nn
6860 c write (iout,*) "itask",itask
6863 if (iproc.gt.0) then
6864 do j=1,num_cont_hb(ii)
6866 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6868 ncont_sent(iproc)=ncont_sent(iproc)+1
6869 nn=ncont_sent(iproc)
6870 zapas(1,nn,iproc)=ii
6871 zapas(2,nn,iproc)=jjc
6872 zapas(3,nn,iproc)=d_cont(j,ii)
6876 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6881 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6889 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6901 c------------------------------------------------------------------------------
6902 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6903 implicit real*8 (a-h,o-z)
6904 include 'DIMENSIONS'
6905 include 'COMMON.IOUNITS'
6906 include 'COMMON.DERIV'
6907 include 'COMMON.INTERACT'
6908 include 'COMMON.CONTACTS'
6909 double precision gx(3),gx1(3)
6919 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6920 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6921 C Following 4 lines for diagnostics.
6926 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6927 c & 'Contacts ',i,j,
6928 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6929 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6931 C Calculate the multi-body contribution to energy.
6932 c ecorr=ecorr+ekont*ees
6933 C Calculate multi-body contributions to the gradient.
6934 coeffpees0pij=coeffp*ees0pij
6935 coeffmees0mij=coeffm*ees0mij
6936 coeffpees0pkl=coeffp*ees0pkl
6937 coeffmees0mkl=coeffm*ees0mkl
6939 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6940 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6941 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6942 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6943 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6944 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6945 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6946 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6947 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6948 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6949 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6950 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6951 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6952 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6953 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6954 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6955 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6956 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6957 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6958 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6959 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6960 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6961 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6962 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6963 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6968 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6969 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6970 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6971 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6976 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6977 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6978 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6979 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6982 c write (iout,*) "ehbcorr",ekont*ees
6987 C---------------------------------------------------------------------------
6988 subroutine dipole(i,j,jj)
6989 implicit real*8 (a-h,o-z)
6990 include 'DIMENSIONS'
6991 include 'COMMON.IOUNITS'
6992 include 'COMMON.CHAIN'
6993 include 'COMMON.FFIELD'
6994 include 'COMMON.DERIV'
6995 include 'COMMON.INTERACT'
6996 include 'COMMON.CONTACTS'
6997 include 'COMMON.TORSION'
6998 include 'COMMON.VAR'
6999 include 'COMMON.GEO'
7000 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7002 iti1 = itortyp(itype(i+1))
7003 if (j.lt.nres-1) then
7004 itj1 = itortyp(itype(j+1))
7009 dipi(iii,1)=Ub2(iii,i)
7010 dipderi(iii)=Ub2der(iii,i)
7011 dipi(iii,2)=b1(iii,iti1)
7012 dipj(iii,1)=Ub2(iii,j)
7013 dipderj(iii)=Ub2der(iii,j)
7014 dipj(iii,2)=b1(iii,itj1)
7018 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7021 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7028 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7032 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7037 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7038 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7040 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7042 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7044 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7049 C---------------------------------------------------------------------------
7050 subroutine calc_eello(i,j,k,l,jj,kk)
7052 C This subroutine computes matrices and vectors needed to calculate
7053 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7055 implicit real*8 (a-h,o-z)
7056 include 'DIMENSIONS'
7057 include 'COMMON.IOUNITS'
7058 include 'COMMON.CHAIN'
7059 include 'COMMON.DERIV'
7060 include 'COMMON.INTERACT'
7061 include 'COMMON.CONTACTS'
7062 include 'COMMON.TORSION'
7063 include 'COMMON.VAR'
7064 include 'COMMON.GEO'
7065 include 'COMMON.FFIELD'
7066 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7067 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7070 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7071 cd & ' jj=',jj,' kk=',kk
7072 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7073 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7074 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7077 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7078 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7081 call transpose2(aa1(1,1),aa1t(1,1))
7082 call transpose2(aa2(1,1),aa2t(1,1))
7085 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7086 & aa1tder(1,1,lll,kkk))
7087 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7088 & aa2tder(1,1,lll,kkk))
7092 C parallel orientation of the two CA-CA-CA frames.
7094 iti=itortyp(itype(i))
7098 itk1=itortyp(itype(k+1))
7099 itj=itortyp(itype(j))
7100 if (l.lt.nres-1) then
7101 itl1=itortyp(itype(l+1))
7105 C A1 kernel(j+1) A2T
7107 cd write (iout,'(3f10.5,5x,3f10.5)')
7108 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7110 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7111 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7112 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7113 C Following matrices are needed only for 6-th order cumulants
7114 IF (wcorr6.gt.0.0d0) THEN
7115 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7116 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7117 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7118 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7119 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7120 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7121 & ADtEAderx(1,1,1,1,1,1))
7123 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7124 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7125 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7126 & ADtEA1derx(1,1,1,1,1,1))
7128 C End 6-th order cumulants
7131 cd write (2,*) 'In calc_eello6'
7133 cd write (2,*) 'iii=',iii
7135 cd write (2,*) 'kkk=',kkk
7137 cd write (2,'(3(2f10.5),5x)')
7138 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7143 call transpose2(EUgder(1,1,k),auxmat(1,1))
7144 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7145 call transpose2(EUg(1,1,k),auxmat(1,1))
7146 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7147 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7151 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7152 & EAEAderx(1,1,lll,kkk,iii,1))
7156 C A1T kernel(i+1) A2
7157 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7158 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7159 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7160 C Following matrices are needed only for 6-th order cumulants
7161 IF (wcorr6.gt.0.0d0) THEN
7162 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7163 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7164 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7165 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7166 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7167 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7168 & ADtEAderx(1,1,1,1,1,2))
7169 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7170 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7171 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7172 & ADtEA1derx(1,1,1,1,1,2))
7174 C End 6-th order cumulants
7175 call transpose2(EUgder(1,1,l),auxmat(1,1))
7176 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7177 call transpose2(EUg(1,1,l),auxmat(1,1))
7178 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7179 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7183 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7184 & EAEAderx(1,1,lll,kkk,iii,2))
7189 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7190 C They are needed only when the fifth- or the sixth-order cumulants are
7192 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7193 call transpose2(AEA(1,1,1),auxmat(1,1))
7194 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7195 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7196 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7197 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7198 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7199 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7200 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7201 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7202 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7203 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7204 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7205 call transpose2(AEA(1,1,2),auxmat(1,1))
7206 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7207 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7208 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7209 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7210 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7211 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7212 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7213 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7214 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7215 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7216 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7217 C Calculate the Cartesian derivatives of the vectors.
7221 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7222 call matvec2(auxmat(1,1),b1(1,iti),
7223 & AEAb1derx(1,lll,kkk,iii,1,1))
7224 call matvec2(auxmat(1,1),Ub2(1,i),
7225 & AEAb2derx(1,lll,kkk,iii,1,1))
7226 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7227 & AEAb1derx(1,lll,kkk,iii,2,1))
7228 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7229 & AEAb2derx(1,lll,kkk,iii,2,1))
7230 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7231 call matvec2(auxmat(1,1),b1(1,itj),
7232 & AEAb1derx(1,lll,kkk,iii,1,2))
7233 call matvec2(auxmat(1,1),Ub2(1,j),
7234 & AEAb2derx(1,lll,kkk,iii,1,2))
7235 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7236 & AEAb1derx(1,lll,kkk,iii,2,2))
7237 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7238 & AEAb2derx(1,lll,kkk,iii,2,2))
7245 C Antiparallel orientation of the two CA-CA-CA frames.
7247 iti=itortyp(itype(i))
7251 itk1=itortyp(itype(k+1))
7252 itl=itortyp(itype(l))
7253 itj=itortyp(itype(j))
7254 if (j.lt.nres-1) then
7255 itj1=itortyp(itype(j+1))
7259 C A2 kernel(j-1)T A1T
7260 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7261 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7262 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7263 C Following matrices are needed only for 6-th order cumulants
7264 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7265 & j.eq.i+4 .and. l.eq.i+3)) THEN
7266 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7267 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7268 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7269 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7270 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7271 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7272 & ADtEAderx(1,1,1,1,1,1))
7273 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7274 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7275 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7276 & ADtEA1derx(1,1,1,1,1,1))
7278 C End 6-th order cumulants
7279 call transpose2(EUgder(1,1,k),auxmat(1,1))
7280 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7281 call transpose2(EUg(1,1,k),auxmat(1,1))
7282 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7283 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7287 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7288 & EAEAderx(1,1,lll,kkk,iii,1))
7292 C A2T kernel(i+1)T A1
7293 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7294 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7295 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7296 C Following matrices are needed only for 6-th order cumulants
7297 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7298 & j.eq.i+4 .and. l.eq.i+3)) THEN
7299 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7300 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7301 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7302 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7303 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7304 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7305 & ADtEAderx(1,1,1,1,1,2))
7306 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7307 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7308 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7309 & ADtEA1derx(1,1,1,1,1,2))
7311 C End 6-th order cumulants
7312 call transpose2(EUgder(1,1,j),auxmat(1,1))
7313 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7314 call transpose2(EUg(1,1,j),auxmat(1,1))
7315 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7316 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7320 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7321 & EAEAderx(1,1,lll,kkk,iii,2))
7326 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7327 C They are needed only when the fifth- or the sixth-order cumulants are
7329 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7330 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7331 call transpose2(AEA(1,1,1),auxmat(1,1))
7332 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7333 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7334 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7335 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7336 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7337 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7338 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7339 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7340 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7341 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7342 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7343 call transpose2(AEA(1,1,2),auxmat(1,1))
7344 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7345 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7346 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7347 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7348 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7349 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7350 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7351 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7352 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7353 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7354 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7355 C Calculate the Cartesian derivatives of the vectors.
7359 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7360 call matvec2(auxmat(1,1),b1(1,iti),
7361 & AEAb1derx(1,lll,kkk,iii,1,1))
7362 call matvec2(auxmat(1,1),Ub2(1,i),
7363 & AEAb2derx(1,lll,kkk,iii,1,1))
7364 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7365 & AEAb1derx(1,lll,kkk,iii,2,1))
7366 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7367 & AEAb2derx(1,lll,kkk,iii,2,1))
7368 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7369 call matvec2(auxmat(1,1),b1(1,itl),
7370 & AEAb1derx(1,lll,kkk,iii,1,2))
7371 call matvec2(auxmat(1,1),Ub2(1,l),
7372 & AEAb2derx(1,lll,kkk,iii,1,2))
7373 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7374 & AEAb1derx(1,lll,kkk,iii,2,2))
7375 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7376 & AEAb2derx(1,lll,kkk,iii,2,2))
7385 C---------------------------------------------------------------------------
7386 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7387 & KK,KKderg,AKA,AKAderg,AKAderx)
7391 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7392 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7393 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7398 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7400 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7403 cd if (lprn) write (2,*) 'In kernel'
7405 cd if (lprn) write (2,*) 'kkk=',kkk
7407 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7408 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7410 cd write (2,*) 'lll=',lll
7411 cd write (2,*) 'iii=1'
7413 cd write (2,'(3(2f10.5),5x)')
7414 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7417 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7418 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7420 cd write (2,*) 'lll=',lll
7421 cd write (2,*) 'iii=2'
7423 cd write (2,'(3(2f10.5),5x)')
7424 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7431 C---------------------------------------------------------------------------
7432 double precision function eello4(i,j,k,l,jj,kk)
7433 implicit real*8 (a-h,o-z)
7434 include 'DIMENSIONS'
7435 include 'COMMON.IOUNITS'
7436 include 'COMMON.CHAIN'
7437 include 'COMMON.DERIV'
7438 include 'COMMON.INTERACT'
7439 include 'COMMON.CONTACTS'
7440 include 'COMMON.TORSION'
7441 include 'COMMON.VAR'
7442 include 'COMMON.GEO'
7443 double precision pizda(2,2),ggg1(3),ggg2(3)
7444 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7448 cd print *,'eello4:',i,j,k,l,jj,kk
7449 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7450 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7451 cold eij=facont_hb(jj,i)
7452 cold ekl=facont_hb(kk,k)
7454 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7455 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7456 gcorr_loc(k-1)=gcorr_loc(k-1)
7457 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7459 gcorr_loc(l-1)=gcorr_loc(l-1)
7460 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7462 gcorr_loc(j-1)=gcorr_loc(j-1)
7463 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7468 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7469 & -EAEAderx(2,2,lll,kkk,iii,1)
7470 cd derx(lll,kkk,iii)=0.0d0
7474 cd gcorr_loc(l-1)=0.0d0
7475 cd gcorr_loc(j-1)=0.0d0
7476 cd gcorr_loc(k-1)=0.0d0
7478 cd write (iout,*)'Contacts have occurred for peptide groups',
7479 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7480 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7481 if (j.lt.nres-1) then
7488 if (l.lt.nres-1) then
7496 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7497 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7498 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7499 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7500 cgrad ghalf=0.5d0*ggg1(ll)
7501 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7502 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7503 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7504 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7505 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7506 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7507 cgrad ghalf=0.5d0*ggg2(ll)
7508 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7509 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7510 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7511 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7512 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7513 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7517 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7522 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7527 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7532 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7536 cd write (2,*) iii,gcorr_loc(iii)
7539 cd write (2,*) 'ekont',ekont
7540 cd write (iout,*) 'eello4',ekont*eel4
7543 C---------------------------------------------------------------------------
7544 double precision function eello5(i,j,k,l,jj,kk)
7545 implicit real*8 (a-h,o-z)
7546 include 'DIMENSIONS'
7547 include 'COMMON.IOUNITS'
7548 include 'COMMON.CHAIN'
7549 include 'COMMON.DERIV'
7550 include 'COMMON.INTERACT'
7551 include 'COMMON.CONTACTS'
7552 include 'COMMON.TORSION'
7553 include 'COMMON.VAR'
7554 include 'COMMON.GEO'
7555 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7556 double precision ggg1(3),ggg2(3)
7557 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7562 C /l\ / \ \ / \ / \ / C
7563 C / \ / \ \ / \ / \ / C
7564 C j| o |l1 | o | o| o | | o |o C
7565 C \ |/k\| |/ \| / |/ \| |/ \| C
7566 C \i/ \ / \ / / \ / \ C
7568 C (I) (II) (III) (IV) C
7570 C eello5_1 eello5_2 eello5_3 eello5_4 C
7572 C Antiparallel chains C
7575 C /j\ / \ \ / \ / \ / C
7576 C / \ / \ \ / \ / \ / C
7577 C j1| o |l | o | o| o | | o |o C
7578 C \ |/k\| |/ \| / |/ \| |/ \| C
7579 C \i/ \ / \ / / \ / \ C
7581 C (I) (II) (III) (IV) C
7583 C eello5_1 eello5_2 eello5_3 eello5_4 C
7585 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7587 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7588 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7593 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7595 itk=itortyp(itype(k))
7596 itl=itortyp(itype(l))
7597 itj=itortyp(itype(j))
7602 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7603 cd & eel5_3_num,eel5_4_num)
7607 derx(lll,kkk,iii)=0.0d0
7611 cd eij=facont_hb(jj,i)
7612 cd ekl=facont_hb(kk,k)
7614 cd write (iout,*)'Contacts have occurred for peptide groups',
7615 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7617 C Contribution from the graph I.
7618 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7619 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7620 call transpose2(EUg(1,1,k),auxmat(1,1))
7621 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7622 vv(1)=pizda(1,1)-pizda(2,2)
7623 vv(2)=pizda(1,2)+pizda(2,1)
7624 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7625 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7626 C Explicit gradient in virtual-dihedral angles.
7627 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7628 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7629 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7630 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7631 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7632 vv(1)=pizda(1,1)-pizda(2,2)
7633 vv(2)=pizda(1,2)+pizda(2,1)
7634 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7635 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7636 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7637 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7638 vv(1)=pizda(1,1)-pizda(2,2)
7639 vv(2)=pizda(1,2)+pizda(2,1)
7641 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7642 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7643 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7645 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7646 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7647 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7649 C Cartesian gradient
7653 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7655 vv(1)=pizda(1,1)-pizda(2,2)
7656 vv(2)=pizda(1,2)+pizda(2,1)
7657 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7658 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7659 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7665 C Contribution from graph II
7666 call transpose2(EE(1,1,itk),auxmat(1,1))
7667 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7668 vv(1)=pizda(1,1)+pizda(2,2)
7669 vv(2)=pizda(2,1)-pizda(1,2)
7670 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7671 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7672 C Explicit gradient in virtual-dihedral angles.
7673 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7674 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7675 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7676 vv(1)=pizda(1,1)+pizda(2,2)
7677 vv(2)=pizda(2,1)-pizda(1,2)
7679 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7680 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7681 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7683 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7684 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7685 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7687 C Cartesian gradient
7691 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7693 vv(1)=pizda(1,1)+pizda(2,2)
7694 vv(2)=pizda(2,1)-pizda(1,2)
7695 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7696 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7697 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7705 C Parallel orientation
7706 C Contribution from graph III
7707 call transpose2(EUg(1,1,l),auxmat(1,1))
7708 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7709 vv(1)=pizda(1,1)-pizda(2,2)
7710 vv(2)=pizda(1,2)+pizda(2,1)
7711 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7712 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7713 C Explicit gradient in virtual-dihedral angles.
7714 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7715 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7716 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7717 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7718 vv(1)=pizda(1,1)-pizda(2,2)
7719 vv(2)=pizda(1,2)+pizda(2,1)
7720 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7721 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7722 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7723 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7724 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7725 vv(1)=pizda(1,1)-pizda(2,2)
7726 vv(2)=pizda(1,2)+pizda(2,1)
7727 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7728 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7729 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7730 C Cartesian gradient
7734 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7736 vv(1)=pizda(1,1)-pizda(2,2)
7737 vv(2)=pizda(1,2)+pizda(2,1)
7738 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7739 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7740 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7745 C Contribution from graph IV
7747 call transpose2(EE(1,1,itl),auxmat(1,1))
7748 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7749 vv(1)=pizda(1,1)+pizda(2,2)
7750 vv(2)=pizda(2,1)-pizda(1,2)
7751 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7752 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7753 C Explicit gradient in virtual-dihedral angles.
7754 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7755 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7756 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7757 vv(1)=pizda(1,1)+pizda(2,2)
7758 vv(2)=pizda(2,1)-pizda(1,2)
7759 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7760 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7761 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7762 C Cartesian gradient
7766 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7768 vv(1)=pizda(1,1)+pizda(2,2)
7769 vv(2)=pizda(2,1)-pizda(1,2)
7770 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7771 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7772 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7777 C Antiparallel orientation
7778 C Contribution from graph III
7780 call transpose2(EUg(1,1,j),auxmat(1,1))
7781 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7782 vv(1)=pizda(1,1)-pizda(2,2)
7783 vv(2)=pizda(1,2)+pizda(2,1)
7784 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7785 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7786 C Explicit gradient in virtual-dihedral angles.
7787 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7788 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7789 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7790 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7791 vv(1)=pizda(1,1)-pizda(2,2)
7792 vv(2)=pizda(1,2)+pizda(2,1)
7793 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7794 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7795 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7796 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7797 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7798 vv(1)=pizda(1,1)-pizda(2,2)
7799 vv(2)=pizda(1,2)+pizda(2,1)
7800 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7801 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7802 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7803 C Cartesian gradient
7807 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7809 vv(1)=pizda(1,1)-pizda(2,2)
7810 vv(2)=pizda(1,2)+pizda(2,1)
7811 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7812 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7813 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7818 C Contribution from graph IV
7820 call transpose2(EE(1,1,itj),auxmat(1,1))
7821 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7822 vv(1)=pizda(1,1)+pizda(2,2)
7823 vv(2)=pizda(2,1)-pizda(1,2)
7824 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7825 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7826 C Explicit gradient in virtual-dihedral angles.
7827 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7828 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7829 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7830 vv(1)=pizda(1,1)+pizda(2,2)
7831 vv(2)=pizda(2,1)-pizda(1,2)
7832 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7833 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7834 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7835 C Cartesian gradient
7839 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7841 vv(1)=pizda(1,1)+pizda(2,2)
7842 vv(2)=pizda(2,1)-pizda(1,2)
7843 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7844 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7845 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7851 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7852 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7853 cd write (2,*) 'ijkl',i,j,k,l
7854 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7855 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7857 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7858 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7859 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7860 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7861 if (j.lt.nres-1) then
7868 if (l.lt.nres-1) then
7878 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7879 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7880 C summed up outside the subrouine as for the other subroutines
7881 C handling long-range interactions. The old code is commented out
7882 C with "cgrad" to keep track of changes.
7884 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7885 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7886 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7887 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7888 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7889 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7890 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7891 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7892 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7893 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7895 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7896 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7897 cgrad ghalf=0.5d0*ggg1(ll)
7899 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7900 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7901 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7902 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7903 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7904 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7905 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7906 cgrad ghalf=0.5d0*ggg2(ll)
7908 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7909 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7910 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7911 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7912 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7913 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7918 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7919 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7924 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7925 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7931 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7936 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7940 cd write (2,*) iii,g_corr5_loc(iii)
7943 cd write (2,*) 'ekont',ekont
7944 cd write (iout,*) 'eello5',ekont*eel5
7947 c--------------------------------------------------------------------------
7948 double precision function eello6(i,j,k,l,jj,kk)
7949 implicit real*8 (a-h,o-z)
7950 include 'DIMENSIONS'
7951 include 'COMMON.IOUNITS'
7952 include 'COMMON.CHAIN'
7953 include 'COMMON.DERIV'
7954 include 'COMMON.INTERACT'
7955 include 'COMMON.CONTACTS'
7956 include 'COMMON.TORSION'
7957 include 'COMMON.VAR'
7958 include 'COMMON.GEO'
7959 include 'COMMON.FFIELD'
7960 double precision ggg1(3),ggg2(3)
7961 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7966 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7974 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7975 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7979 derx(lll,kkk,iii)=0.0d0
7983 cd eij=facont_hb(jj,i)
7984 cd ekl=facont_hb(kk,k)
7990 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7991 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7992 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7993 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7994 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7995 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7997 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7998 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7999 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8000 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8001 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8002 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8006 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8008 C If turn contributions are considered, they will be handled separately.
8009 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8010 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8011 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8012 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8013 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8014 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8015 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8017 if (j.lt.nres-1) then
8024 if (l.lt.nres-1) then
8032 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8033 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8034 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8035 cgrad ghalf=0.5d0*ggg1(ll)
8037 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8038 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8039 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8040 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8041 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8042 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8043 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8044 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8045 cgrad ghalf=0.5d0*ggg2(ll)
8046 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8048 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8049 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8050 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8051 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8052 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8053 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8058 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8059 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8064 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8065 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8071 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8076 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8080 cd write (2,*) iii,g_corr6_loc(iii)
8083 cd write (2,*) 'ekont',ekont
8084 cd write (iout,*) 'eello6',ekont*eel6
8087 c--------------------------------------------------------------------------
8088 double precision function eello6_graph1(i,j,k,l,imat,swap)
8089 implicit real*8 (a-h,o-z)
8090 include 'DIMENSIONS'
8091 include 'COMMON.IOUNITS'
8092 include 'COMMON.CHAIN'
8093 include 'COMMON.DERIV'
8094 include 'COMMON.INTERACT'
8095 include 'COMMON.CONTACTS'
8096 include 'COMMON.TORSION'
8097 include 'COMMON.VAR'
8098 include 'COMMON.GEO'
8099 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8103 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8105 C Parallel Antiparallel
8111 C \ j|/k\| / \ |/k\|l /
8116 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8117 itk=itortyp(itype(k))
8118 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8119 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8120 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8121 call transpose2(EUgC(1,1,k),auxmat(1,1))
8122 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8123 vv1(1)=pizda1(1,1)-pizda1(2,2)
8124 vv1(2)=pizda1(1,2)+pizda1(2,1)
8125 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8126 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8127 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8128 s5=scalar2(vv(1),Dtobr2(1,i))
8129 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8130 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8131 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8132 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8133 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8134 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8135 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8136 & +scalar2(vv(1),Dtobr2der(1,i)))
8137 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8138 vv1(1)=pizda1(1,1)-pizda1(2,2)
8139 vv1(2)=pizda1(1,2)+pizda1(2,1)
8140 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8141 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8143 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8144 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8145 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8146 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8147 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8149 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8150 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8151 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8152 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8153 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8155 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8156 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8157 vv1(1)=pizda1(1,1)-pizda1(2,2)
8158 vv1(2)=pizda1(1,2)+pizda1(2,1)
8159 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8160 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8161 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8162 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8171 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8172 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8173 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8174 call transpose2(EUgC(1,1,k),auxmat(1,1))
8175 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8177 vv1(1)=pizda1(1,1)-pizda1(2,2)
8178 vv1(2)=pizda1(1,2)+pizda1(2,1)
8179 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8180 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8181 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8182 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8183 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8184 s5=scalar2(vv(1),Dtobr2(1,i))
8185 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8191 c----------------------------------------------------------------------------
8192 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8193 implicit real*8 (a-h,o-z)
8194 include 'DIMENSIONS'
8195 include 'COMMON.IOUNITS'
8196 include 'COMMON.CHAIN'
8197 include 'COMMON.DERIV'
8198 include 'COMMON.INTERACT'
8199 include 'COMMON.CONTACTS'
8200 include 'COMMON.TORSION'
8201 include 'COMMON.VAR'
8202 include 'COMMON.GEO'
8204 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8205 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8208 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8210 C Parallel Antiparallel C
8216 C \ j|/k\| \ |/k\|l C
8221 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8222 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8223 C AL 7/4/01 s1 would occur in the sixth-order moment,
8224 C but not in a cluster cumulant
8226 s1=dip(1,jj,i)*dip(1,kk,k)
8228 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8229 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8230 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8231 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8232 call transpose2(EUg(1,1,k),auxmat(1,1))
8233 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8234 vv(1)=pizda(1,1)-pizda(2,2)
8235 vv(2)=pizda(1,2)+pizda(2,1)
8236 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8237 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8239 eello6_graph2=-(s1+s2+s3+s4)
8241 eello6_graph2=-(s2+s3+s4)
8244 C Derivatives in gamma(i-1)
8247 s1=dipderg(1,jj,i)*dip(1,kk,k)
8249 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8250 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8251 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8252 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8254 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8256 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8258 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8260 C Derivatives in gamma(k-1)
8262 s1=dip(1,jj,i)*dipderg(1,kk,k)
8264 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8265 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8266 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8267 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8268 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8269 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8270 vv(1)=pizda(1,1)-pizda(2,2)
8271 vv(2)=pizda(1,2)+pizda(2,1)
8272 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8274 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8276 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8278 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8279 C Derivatives in gamma(j-1) or gamma(l-1)
8282 s1=dipderg(3,jj,i)*dip(1,kk,k)
8284 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8285 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8286 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8287 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8288 vv(1)=pizda(1,1)-pizda(2,2)
8289 vv(2)=pizda(1,2)+pizda(2,1)
8290 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8293 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8295 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8298 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8299 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8301 C Derivatives in gamma(l-1) or gamma(j-1)
8304 s1=dip(1,jj,i)*dipderg(3,kk,k)
8306 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8307 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8308 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8309 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8310 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8311 vv(1)=pizda(1,1)-pizda(2,2)
8312 vv(2)=pizda(1,2)+pizda(2,1)
8313 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8316 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8318 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8321 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8322 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8324 C Cartesian derivatives.
8326 write (2,*) 'In eello6_graph2'
8328 write (2,*) 'iii=',iii
8330 write (2,*) 'kkk=',kkk
8332 write (2,'(3(2f10.5),5x)')
8333 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8343 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8345 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8348 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8350 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8351 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8353 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8354 call transpose2(EUg(1,1,k),auxmat(1,1))
8355 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8357 vv(1)=pizda(1,1)-pizda(2,2)
8358 vv(2)=pizda(1,2)+pizda(2,1)
8359 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8360 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8362 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8364 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8367 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8369 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8376 c----------------------------------------------------------------------------
8377 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8378 implicit real*8 (a-h,o-z)
8379 include 'DIMENSIONS'
8380 include 'COMMON.IOUNITS'
8381 include 'COMMON.CHAIN'
8382 include 'COMMON.DERIV'
8383 include 'COMMON.INTERACT'
8384 include 'COMMON.CONTACTS'
8385 include 'COMMON.TORSION'
8386 include 'COMMON.VAR'
8387 include 'COMMON.GEO'
8388 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8390 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8392 C Parallel Antiparallel C
8398 C j|/k\| / |/k\|l / C
8403 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8405 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8406 C energy moment and not to the cluster cumulant.
8407 iti=itortyp(itype(i))
8408 if (j.lt.nres-1) then
8409 itj1=itortyp(itype(j+1))
8413 itk=itortyp(itype(k))
8414 itk1=itortyp(itype(k+1))
8415 if (l.lt.nres-1) then
8416 itl1=itortyp(itype(l+1))
8421 s1=dip(4,jj,i)*dip(4,kk,k)
8423 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8424 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8425 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8426 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8427 call transpose2(EE(1,1,itk),auxmat(1,1))
8428 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8429 vv(1)=pizda(1,1)+pizda(2,2)
8430 vv(2)=pizda(2,1)-pizda(1,2)
8431 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8432 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8433 cd & "sum",-(s2+s3+s4)
8435 eello6_graph3=-(s1+s2+s3+s4)
8437 eello6_graph3=-(s2+s3+s4)
8440 C Derivatives in gamma(k-1)
8441 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8442 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8443 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8444 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8445 C Derivatives in gamma(l-1)
8446 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8447 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8448 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8449 vv(1)=pizda(1,1)+pizda(2,2)
8450 vv(2)=pizda(2,1)-pizda(1,2)
8451 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8452 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8453 C Cartesian derivatives.
8459 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8461 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8464 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8466 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8467 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8469 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8470 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8472 vv(1)=pizda(1,1)+pizda(2,2)
8473 vv(2)=pizda(2,1)-pizda(1,2)
8474 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8476 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8478 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8481 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8483 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8485 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8491 c----------------------------------------------------------------------------
8492 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8493 implicit real*8 (a-h,o-z)
8494 include 'DIMENSIONS'
8495 include 'COMMON.IOUNITS'
8496 include 'COMMON.CHAIN'
8497 include 'COMMON.DERIV'
8498 include 'COMMON.INTERACT'
8499 include 'COMMON.CONTACTS'
8500 include 'COMMON.TORSION'
8501 include 'COMMON.VAR'
8502 include 'COMMON.GEO'
8503 include 'COMMON.FFIELD'
8504 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8505 & auxvec1(2),auxmat1(2,2)
8507 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8509 C Parallel Antiparallel C
8515 C \ j|/k\| \ |/k\|l C
8520 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8522 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8523 C energy moment and not to the cluster cumulant.
8524 cd write (2,*) 'eello_graph4: wturn6',wturn6
8525 iti=itortyp(itype(i))
8526 itj=itortyp(itype(j))
8527 if (j.lt.nres-1) then
8528 itj1=itortyp(itype(j+1))
8532 itk=itortyp(itype(k))
8533 if (k.lt.nres-1) then
8534 itk1=itortyp(itype(k+1))
8538 itl=itortyp(itype(l))
8539 if (l.lt.nres-1) then
8540 itl1=itortyp(itype(l+1))
8544 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8545 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8546 cd & ' itl',itl,' itl1',itl1
8549 s1=dip(3,jj,i)*dip(3,kk,k)
8551 s1=dip(2,jj,j)*dip(2,kk,l)
8554 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8555 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8557 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8558 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8560 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8561 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8563 call transpose2(EUg(1,1,k),auxmat(1,1))
8564 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8565 vv(1)=pizda(1,1)-pizda(2,2)
8566 vv(2)=pizda(2,1)+pizda(1,2)
8567 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8568 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8570 eello6_graph4=-(s1+s2+s3+s4)
8572 eello6_graph4=-(s2+s3+s4)
8574 C Derivatives in gamma(i-1)
8578 s1=dipderg(2,jj,i)*dip(3,kk,k)
8580 s1=dipderg(4,jj,j)*dip(2,kk,l)
8583 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8585 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8586 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8588 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8589 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8591 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8592 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8593 cd write (2,*) 'turn6 derivatives'
8595 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8597 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8601 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8603 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8607 C Derivatives in gamma(k-1)
8610 s1=dip(3,jj,i)*dipderg(2,kk,k)
8612 s1=dip(2,jj,j)*dipderg(4,kk,l)
8615 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8616 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8618 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8619 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8621 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8622 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8624 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8625 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8626 vv(1)=pizda(1,1)-pizda(2,2)
8627 vv(2)=pizda(2,1)+pizda(1,2)
8628 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8629 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8631 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8633 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8637 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8639 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8642 C Derivatives in gamma(j-1) or gamma(l-1)
8643 if (l.eq.j+1 .and. l.gt.1) then
8644 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8645 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8646 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8647 vv(1)=pizda(1,1)-pizda(2,2)
8648 vv(2)=pizda(2,1)+pizda(1,2)
8649 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8650 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8651 else if (j.gt.1) then
8652 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8653 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8654 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8655 vv(1)=pizda(1,1)-pizda(2,2)
8656 vv(2)=pizda(2,1)+pizda(1,2)
8657 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8658 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8659 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8661 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8664 C Cartesian derivatives.
8671 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8673 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8677 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8679 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8683 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8685 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8687 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8688 & b1(1,itj1),auxvec(1))
8689 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8691 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8692 & b1(1,itl1),auxvec(1))
8693 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8695 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8697 vv(1)=pizda(1,1)-pizda(2,2)
8698 vv(2)=pizda(2,1)+pizda(1,2)
8699 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8701 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8703 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8706 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8709 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8712 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8714 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8716 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8720 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8722 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8725 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8727 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8735 c----------------------------------------------------------------------------
8736 double precision function eello_turn6(i,jj,kk)
8737 implicit real*8 (a-h,o-z)
8738 include 'DIMENSIONS'
8739 include 'COMMON.IOUNITS'
8740 include 'COMMON.CHAIN'
8741 include 'COMMON.DERIV'
8742 include 'COMMON.INTERACT'
8743 include 'COMMON.CONTACTS'
8744 include 'COMMON.TORSION'
8745 include 'COMMON.VAR'
8746 include 'COMMON.GEO'
8747 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8748 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8750 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8751 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8752 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8753 C the respective energy moment and not to the cluster cumulant.
8762 iti=itortyp(itype(i))
8763 itk=itortyp(itype(k))
8764 itk1=itortyp(itype(k+1))
8765 itl=itortyp(itype(l))
8766 itj=itortyp(itype(j))
8767 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8768 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8769 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8774 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8776 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8780 derx_turn(lll,kkk,iii)=0.0d0
8787 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8789 cd write (2,*) 'eello6_5',eello6_5
8791 call transpose2(AEA(1,1,1),auxmat(1,1))
8792 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8793 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8794 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8796 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8797 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8798 s2 = scalar2(b1(1,itk),vtemp1(1))
8800 call transpose2(AEA(1,1,2),atemp(1,1))
8801 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8802 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8803 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8805 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8806 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8807 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8809 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8810 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8811 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8812 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8813 ss13 = scalar2(b1(1,itk),vtemp4(1))
8814 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8816 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8822 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8823 C Derivatives in gamma(i+2)
8827 call transpose2(AEA(1,1,1),auxmatd(1,1))
8828 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8829 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8830 call transpose2(AEAderg(1,1,2),atempd(1,1))
8831 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8832 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8834 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8835 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8836 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8842 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8843 C Derivatives in gamma(i+3)
8845 call transpose2(AEA(1,1,1),auxmatd(1,1))
8846 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8847 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8848 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8850 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8851 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8852 s2d = scalar2(b1(1,itk),vtemp1d(1))
8854 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8855 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8857 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8859 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8860 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8861 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8869 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8870 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8872 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8873 & -0.5d0*ekont*(s2d+s12d)
8875 C Derivatives in gamma(i+4)
8876 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8877 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8878 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8880 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8881 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8882 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8890 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8892 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8894 C Derivatives in gamma(i+5)
8896 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8897 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8898 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8900 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8901 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8902 s2d = scalar2(b1(1,itk),vtemp1d(1))
8904 call transpose2(AEA(1,1,2),atempd(1,1))
8905 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8906 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8908 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8909 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8911 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8912 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8913 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8921 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8922 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8924 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8925 & -0.5d0*ekont*(s2d+s12d)
8927 C Cartesian derivatives
8932 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8933 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8934 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8936 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8937 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8939 s2d = scalar2(b1(1,itk),vtemp1d(1))
8941 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8942 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8943 s8d = -(atempd(1,1)+atempd(2,2))*
8944 & scalar2(cc(1,1,itl),vtemp2(1))
8946 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8948 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8949 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8956 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8959 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8963 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8964 & - 0.5d0*(s8d+s12d)
8966 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8975 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8977 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8978 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8979 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8980 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8981 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8983 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8984 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8985 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8989 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8990 cd & 16*eel_turn6_num
8992 if (j.lt.nres-1) then
8999 if (l.lt.nres-1) then
9007 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9008 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9009 cgrad ghalf=0.5d0*ggg1(ll)
9011 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9012 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9013 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9014 & +ekont*derx_turn(ll,2,1)
9015 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9016 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9017 & +ekont*derx_turn(ll,4,1)
9018 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9019 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9020 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9021 cgrad ghalf=0.5d0*ggg2(ll)
9023 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9024 & +ekont*derx_turn(ll,2,2)
9025 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9026 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9027 & +ekont*derx_turn(ll,4,2)
9028 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9029 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9030 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9035 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9040 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9046 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9051 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9055 cd write (2,*) iii,g_corr6_loc(iii)
9057 eello_turn6=ekont*eel_turn6
9058 cd write (2,*) 'ekont',ekont
9059 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9063 C-----------------------------------------------------------------------------
9064 double precision function scalar(u,v)
9065 !DIR$ INLINEALWAYS scalar
9067 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9070 double precision u(3),v(3)
9071 cd double precision sc
9079 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9082 crc-------------------------------------------------
9083 SUBROUTINE MATVEC2(A1,V1,V2)
9084 !DIR$ INLINEALWAYS MATVEC2
9086 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9088 implicit real*8 (a-h,o-z)
9089 include 'DIMENSIONS'
9090 DIMENSION A1(2,2),V1(2),V2(2)
9094 c 3 VI=VI+A1(I,K)*V1(K)
9098 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9099 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9104 C---------------------------------------
9105 SUBROUTINE MATMAT2(A1,A2,A3)
9107 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9109 implicit real*8 (a-h,o-z)
9110 include 'DIMENSIONS'
9111 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9112 c DIMENSION AI3(2,2)
9116 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9122 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9123 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9124 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9125 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9133 c-------------------------------------------------------------------------
9134 double precision function scalar2(u,v)
9135 !DIR$ INLINEALWAYS scalar2
9137 double precision u(2),v(2)
9140 scalar2=u(1)*v(1)+u(2)*v(2)
9144 C-----------------------------------------------------------------------------
9146 subroutine transpose2(a,at)
9147 !DIR$ INLINEALWAYS transpose2
9149 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9152 double precision a(2,2),at(2,2)
9159 c--------------------------------------------------------------------------
9160 subroutine transpose(n,a,at)
9163 double precision a(n,n),at(n,n)
9171 C---------------------------------------------------------------------------
9172 subroutine prodmat3(a1,a2,kk,transp,prod)
9173 !DIR$ INLINEALWAYS prodmat3
9175 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9179 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9181 crc double precision auxmat(2,2),prod_(2,2)
9184 crc call transpose2(kk(1,1),auxmat(1,1))
9185 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9186 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9188 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9189 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9190 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9191 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9192 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9193 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9194 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9195 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9198 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9199 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9201 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9202 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9203 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9204 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9205 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9206 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9207 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9208 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9211 c call transpose2(a2(1,1),a2t(1,1))
9214 crc print *,((prod_(i,j),i=1,2),j=1,2)
9215 crc print *,((prod(i,j),i=1,2),j=1,2)